使用 MS Access 中的 VBA 将附件从一个记录集中的记录复制到另一个记录集中的记录中

使用 MS Access 中的 VBA 将附件从一个记录集中的记录复制到另一个记录集中的记录中

我几乎已经搞定了。我觉得我真的需要另一双眼睛来审视这个问题。我认为我的问题只是一个简单的编程结构问题。要么是循环太多,要么是打开/关闭记录集的顺序错误。

我正在尝试将一个 dao 记录集中的记录中包含的所有附件文件复制到另一个 dao 记录集中的相应记录中。两个记录集都从同一张表中提取数据。第一个记录集 (rstOld) 包含日期值为去年的记录,这些记录可以包含任意数量的附件。第二个记录集 (rstNew) 包含日期值为今年的记录,这些记录不包含任何附件。

为了实现这一点,我开始循环遍历 rstNew 中的每个记录。对于 rstNew 中的每个记录,我将收集 Name 字段的值,然后开始第二个循环。第二个循环将在 rstOld 中找到具有匹配 Name 字段的记录。从那里我只需要将所有附件从 rstOld 中的记录复制到 rstNew 中的记录。

奇怪的是,它在 rstNew 中找到匹配的第一个记录时可以正常工作。此后,它不再适用于任何后续记录。

这是我目前的代码:

    Dim db As Database
    Dim strOldSQL As String
    Dim rstOld As DAO.Recordset2
    Dim strNewSQL As String
    Dim rstNew As DAO.Recordset2
    Dim rstOldAttachments As DAO.Recordset2
    Dim rstNewAttachments As DAO.Recordset2
    Dim strCurrentSiteName As String
    Dim strOldSiteName As String
Set db = CurrentDb()

    'First let's open a recordset that contains all of the records from this year.
    strNewSQL = "SELECT tblAuditForms.SiteName, tblAuditForms.Attachments, tblAuditForms.AuditYear FROM tblAuditForms WHERE AuditYear = #" & Format(cboMyDate, "mm/dd/yyyy") & "# ORDER By tblAuditForms.SiteName;"
    Set rstNew = db.OpenRecordset(strNewSQL)
    rstNew.MoveFirst
    rstNew.Edit
    
    Do While Not rstNew.EOF 'Now we need to loop through these records.
    
        strCurrentSiteName = rstNew.Fields("SiteName").Value 'Get the name of the site for the current record that we're on. We'll use this to compare with the sites in the previous audit.
                    
        'Now let's open a recordset that contains all records from the previous audit.
        strOldSQL = "SELECT tblAuditForms.SiteName, tblAuditForms.Attachments, Year([AuditYear]) FROM tblAuditForms WHERE Year([AuditYear]) = " & Me.cboPreviousDate & " ORDER BY tblAuditForms.SiteName;"
        Set rstOld = db.OpenRecordset(strOldSQL)
        rstOld.MoveFirst
        
        Do While Not rstOld.EOF 'Loop through each of the records from the previous audit until we find a record that matches the current site name.
        
            strOldSiteName = rstOld.Fields("SiteName").Value
        
            If strCurrentSiteName = strOldSiteName Then 'If this is true, then we've found a record from the previous audit that matches the one from our current audit.
                'Now it's just a matter of copying the attachments from the old record into the new one.  Working with attachments is annoying though.
                
                'This next block should loop through the attachments (if any) in the old record and copy them into the new record.
                Set rstOldAttachments = rstOld.Fields("Attachments").Value
                rstOldAttachments.MoveFirst
                
                Set rstNewAttachments = rstNew.Fields("Attachments").Value

                Do While Not rstOldAttachments.EOF
                    
                    rstNewAttachments.AddNew
                    rstNewAttachments.Fields("FileData").Value = rstOldAttachments.Fields("FileData").Value
                    rstNewAttachments.Fields("FileName").Value = rstOldAttachments.Fields("FileName").Value
                    rstNewAttachments.Fields("FileType").Value = rstOldAttachments.Fields("FileType").Value
                    rstNewAttachments.Update
                
                    rstOldAttachments.MoveNext
                Loop
                
                'Now that we've found the site from the previous audit and copied its attachments into the new record we can close the old recordset and move onto the next site in the current audit.
                rstOldAttachments.Close
                rstNewAttachments.Close
                Exit Do
            
            End If
                        
            rstOld.MoveNext
        Loop
         
        rstOld.Close
        rstNew.Update
        rstNew.MoveNext
    Loop
        
    'If we've gotten this far then we've looped through all of the new records that we just created from the weekly staffing workbook.
    rstNew.Close
    
    

就像我之前说的,此代码在第一次循环中会起作用,但不会在任何后续循环中起作用。我是否太早退出循环?或者太早关闭记录集?

答案1

我搞明白了!我知道我已经接近成功了。我了解到,一旦执行 recordset.update(或在我的情况下为 rstNew.update)语句,记录集 editmode 属性就会返回到 0。这可以解释为什么它会在第一次循环中成功复制附件,但在任何后续循环中都会失败。所以我所要做的就是将“rstNew.Edit”语句直接移到“Set rstNewAttachments = rstNew.Fields("Attachments").Value”行上方。

新代码如下:

    Dim db As Database
    Dim strOldSQL As String
    Dim rstOld As DAO.Recordset2
    Dim strNewSQL As String
    Dim rstNew As DAO.Recordset2
    Dim rstOldAttachments As DAO.Recordset2
    Dim rstNewAttachments As DAO.Recordset2
    Dim strCurrentSiteName As String
    Dim strOldSiteName As String
Set db = CurrentDb()

    'First let's open a recordset that contains all of the records from this year.
    strNewSQL = "SELECT tblAuditForms.SiteName, tblAuditForms.Attachments, tblAuditForms.AuditYear FROM tblAuditForms WHERE AuditYear = #" & Format(cboMyDate, "mm/dd/yyyy") & "# ORDER By tblAuditForms.SiteName;"
    Set rstNew = db.OpenRecordset(strNewSQL)
    rstNew.MoveFirst
        
    Do While Not rstNew.EOF 'Now we need to loop through these records.
    
        strCurrentSiteName = rstNew.Fields("SiteName").Value 'Get the name of the site for the current record that we're on. We'll use this to compare with the sites in the previous audit.
                    
        'Now let's open a recordset that contains all records from the previous audit.
        strOldSQL = "SELECT tblAuditForms.SiteName, tblAuditForms.Attachments, Year([AuditYear]) FROM tblAuditForms WHERE Year([AuditYear]) = " & Me.cboPreviousDate & " ORDER BY tblAuditForms.SiteName;"
        Set rstOld = db.OpenRecordset(strOldSQL)
        rstOld.MoveFirst
        
        Do While Not rstOld.EOF 'Loop through each of the records from the previous audit until we find a record that matches the current site name.
        
            strOldSiteName = rstOld.Fields("SiteName").Value
        
            If strCurrentSiteName = strOldSiteName Then 'If this is true, then we've found a record from the previous audit that matches the one from our current audit.
                'Now it's just a matter of copying the attachments from the old record into the new one.  Working with attachments is annoying though.
                
                'This next block should loop through the attachments (if any) in the old record and copy them into the new record.
                Set rstOldAttachments = rstOld.Fields("Attachments").Value
                rstOldAttachments.MoveFirst
                
                rstNew.Edit
                Set rstNewAttachments = rstNew.Fields("Attachments").Value

                Do While Not rstOldAttachments.EOF
                    
                    rstNewAttachments.AddNew
                    rstNewAttachments.Fields("FileData").Value = rstOldAttachments.Fields("FileData").Value
                    rstNewAttachments.Fields("FileName").Value = rstOldAttachments.Fields("FileName").Value
                    rstNewAttachments.Fields("FileType").Value = rstOldAttachments.Fields("FileType").Value
                    rstNewAttachments.Update
                
                    rstOldAttachments.MoveNext
                Loop
                
                'Now that we've found the site from the previous audit and copied its attachments into the new record we can close the old recordset and move onto the next site in the current audit.
                rstOldAttachments.Close
                rstNewAttachments.Close
                Exit Do
            
            End If
                        
            rstOld.MoveNext
        Loop
         
        rstOld.Close
        rstNew.Update
        rstNew.MoveNext
    Loop
        
    'If we've gotten this far then we've looped through all of the new records that we just created from the weekly staffing workbook.
    rstNew.Close

相关内容