循环遍历DAO记录集并复制并粘贴到其他记录集中,然后将其删除

时间:2014-01-28 14:45:17

标签: vba loops dao recordset

我目前正在使用可以通过DAO记录集循环访问我的访问表的VBA代码,我必须在当前时间之前90天找到任何数据并将其作为第二个记录集插入到其他表中,插入到第二个记录集,然后删除数据并移动到下一个数据记录旁边。我的代码在下面,我目前在此集合中找不到运行时错误“3265”项目。

    Private Sub Command22_Click()

        Dim dbs As DAO.Database
        Dim rsDatalog1 As DAO.Recordset
        Dim rsDatalog2 As DAO.Recordset
        Dim time As Date
        time = Now() - 90
        DoCmd.SetWarnings False
        DoCmd.Echo False
        DoCmd.Hourglass True
        Set dbs = CurrentDb()
        Set rsDatalog1 = dbs.OpenRecordset("SELECT DateStamp, LocationID, DataType, LogValue FROM DataLog")
        Do Until rsDatalog1.EOF


                If Not rsDatalog1.EOF Then
                rsDatalog1.MoveFirst
                If Not rsDatalog1.EOF Then
                    rsDatalog1.MoveNext
                    Do Until rsDatalog1.EOF

                        If rsDatalog1.Fields(Datastamp) >= Now() - 90 Then
                        Set reDatalog2 = dbs.OpenRecordset("INSERT INTO Archive VALUE ('" & rsDatalog1("DataStamp") & "', '" & rsDatalog1("LocationID") & "','" & rsDatalog1("DataType") & "','" & rsDatalog1("LogValue") & "'")
                        Debug.Print redatalog1.Field(DateStamp, LocationID, DataType, LogValue)
                        rsDatalog1.Delete
                        rsDatalog1.MoveNext
                        End If
                    Loop
                End If
            End If
            rsDatalog1.Close
            rsDatalog2.Close
        Loop
        DoCmd.Hourglass False
        MsgBox "Finish"
End Sub

1 个答案:

答案 0 :(得分:1)

此问题可能有几个原因。第一个是当If rsDatalog1.Fields(Datastamp) >= Now() - 90 Then DataStamp应该在引号中时。你也可以参考字段!例如rsDatalog1!Datastamp

你的循环中不应该有rsDatalog1.close。这将导致它在下一次传递时失败,因为它无法检查文件的结尾。

你只需要一个循环而不是两个。

在列出要插入的值之前,您的insert语句需要列出您要插入的字段。

Private Sub Command22_Click()    
    Dim dbs As DAO.Database
    Dim rsDatalog1 As DAO.Recordset
    Dim time As Date
    time = Now() - 90
    DoCmd.SetWarnings False
    DoCmd.Echo False
    DoCmd.Hourglass True
    Set dbs = CurrentDb()
    Set rsDatalog1 = dbs.OpenRecordset("SELECT DateStamp, LocationID, DataType, LogValue FROM DataLog")
    Do Until rsDatalog1.EOF
        If rsDatalog1.Fields(Datastamp) >= Now() - 90 Then
            dbs.Execute "INSERT INTO Archive (DataStamp, LocationID, DataType, LogValue) VALUE ('" & rsDatalog1!DataStamp & "', '" & rsDatalog1!LocationID & "','" & rsDatalog1!DataType & "','" & rsDatalog1!LogValue & "')", dbFailOnError
            rsDatalog1.Delete
        End If

        if rsDatalog1.recordCount <> 0 then
            rsDatalog1.MoveNext
        end if
    Loop

    rsDatalog1.close
    set rsDatalog1 = nothing
    DoCmd.Hourglass False
    MsgBox "Finish"
End Sub