Question

我尝试使用SQL，但没有成功。然后我尝试了DAO，其他领域似乎有效，但包含附件的列失败。有人做过吗？

Private Sub copyfromtblA_Click()

Dim db As Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset2
'Set db = CurrentDb()
Set rs1 = db.OpenRecordset("tblA")
Set rs2 = db.OpenRecordset("tblB")

With rs2
rs2.AddNew
rs2.Fields("ItemNo").Value = Me.ItemNo.Value
rs2.Fields("Quantity").Value = Me.Quantity.Value
rs2.Fields("itemName").Value = Me.itemName.Value
'This is were I get the error since this field contains images as attachments
rs2.Fields("ItemImage").Value = Me.itemImage.Value


rs2.Update
rs1.MoveNext

End With
rs2.Close

Form.Requery
Set rs2 = Nothing
rs1.Close
Set rs1 = Nothing

End Sub

Answer 1

类似这样的东西：

Private Sub copyfromtblA_Click()
    Dim db As Database
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim rsAtt1 As DAO.Recordset2
    Dim rsAtt2 As DAO.Recordset2

    Set db = CurrentDb()
    Set rs2 = db.OpenRecordset("tblB")
    With Me.Recordset
        rs2.AddNew
        rs2.Fields("ItemNo").Value = !ItemNo.Value
        rs2.Fields("Quantity").Value = !Quantity.Value
        rs2.Fields("itemName").Value = !itemName.Value
        Set rsAtt1 = !ItemImage.Value
        Set rsAtt2 = rs2!ItemImage.Value
        With rsAtt1
            Do While Not .EOF
                rsAtt2.AddNew
                rsAtt2.Fields("FileData") = .Fields("FileData")
                rsAtt2.Fields("FileName") = .Fields("FileName")
                rsAtt2.Update
                .MoveNext
            Loop
        End With
        rs2.Update
    End With
    rs2.Close
    Set rs2 = Nothing
    rsAtt1.Close
    Set rsAtt1 = Nothing
    'I was getting an error here! removing the "rsAtt2.Close" solved the problem
    'rsAtt2.Close
    Set rsAtt2 = Nothing
End Sub

在Access VBA中，如何将包含附件的字段从单个记录复制到另一个表？

1 个答案: