MS Access VBA中勾选复选框时如何迁移含附件字段的数据？

你遇到的错误是因为Access的附件字段（Picture）属于复杂多值字段，标准的INSERT INTO语句无法直接操作这类字段，必须通过DAO对象来逐行处理记录及附件内容。

下面是修改后的完整代码，替换你原来的SQL执行逻辑：

Private Sub Ordered_Click()
    Dim Inquirycodevar As Integer
    Dim db As DAO.Database
    Dim rsQU As DAO.Recordset
    Dim rsOrders As DAO.Recordset
    Dim rsAttachmentsQU As DAO.Recordset
    Dim rsAttachmentsOrders As DAO.Recordset
    
    Inquirycodevar = Me.Inquirycode.Value
    
    ' 必填字段验证
    If IsNull(Me.Inquirycode) Or IsNull(Me.Customer) Or IsNull(Me.Cavitynumber) _
        Or IsNull(Me.Productionmethod) Or IsNull(Me.Partname) Then
        MsgBox "请填写所有必填字段"
        Me.Ordered.Value = 0
        Exit Sub
    End If
    
    On Error GoTo ErrorHandler
    Set db = CurrentDb()
    
    ' 打开QU表中要迁移的目标记录
    Set rsQU = db.OpenRecordset("SELECT * FROM QU WHERE Inquirycode = " & Inquirycodevar, dbOpenDynaset)
    If Not rsQU.EOF Then
        ' 在Orders表中创建新记录
        Set rsOrders = db.OpenRecordset("Orderss", dbOpenDynaset)
        rsOrders.AddNew
        
        ' 复制普通字段内容
        rsOrders!Inquirycode = rsQU!Inquirycode
        rsOrders!Customer = rsQU!Customer
        rsOrders!partname = rsQU!partname
        rsOrders!Cavitynumber = rsQU!Cavitynumber
        rsOrders!Productionmethod = rsQU!Productionmethod
        rsOrders!Price = rsQU!Price
        rsOrders!Comment = rsQU!Comment
        rsOrders!Ordered = rsQU!Ordered
        rsOrders!Datye = Date() ' 注意：确认字段名是否为Datye，若为Date请修改
        
        ' 处理附件字段的迁移
        Set rsAttachmentsQU = rsQU!Picture.Value ' 获取QU表的附件子记录集
        Set rsAttachmentsOrders = rsOrders!Picture.Value ' 获取Orders表的附件子记录集
        
        ' 逐个复制附件的完整信息
        Do While Not rsAttachmentsQU.EOF
            rsAttachmentsOrders.AddNew
            rsAttachmentsOrders!FileData = rsAttachmentsQU!FileData ' 附件二进制数据
            rsAttachmentsOrders!FileName = rsAttachmentsQU!FileName ' 附件文件名
            rsAttachmentsOrders!FileExtension = rsAttachmentsQU!FileExtension ' 附件扩展名
            rsAttachmentsOrders.Update
            rsAttachmentsQU.MoveNext
        Loop
        
        ' 保存Orders表的新记录
        rsOrders.Update
        ' 关闭附件子记录集
        rsAttachmentsOrders.Close
        rsAttachmentsQU.Close
        rsOrders.Close
        
        ' 删除QU表中的原记录
        rsQU.Delete
    End If
    
    ' 清理对象
    rsQU.Close
    Set rsQU = Nothing
    Set rsOrders = Nothing
    Set rsAttachmentsQU = Nothing
    Set rsAttachmentsOrders = Nothing
    Set db = Nothing
    
    Me.Requery ' 刷新表单显示最新状态
    Exit Sub
    
ErrorHandler:
    MsgBox "操作出错：" & Err.Description, vbExclamation
    ' 出错时回滚并清理资源
    If Not rsOrders Is Nothing Then
        If rsOrders.EditMode Then rsOrders.CancelUpdate
        rsOrders.Close
    End If
    If Not rsAttachmentsOrders Is Nothing Then rsAttachmentsOrders.Close
    If Not rsAttachmentsQU Is Nothing Then rsAttachmentsQU.Close
    If Not rsQU Is Nothing Then rsQU.Close
    Set rsQU = Nothing
    Set rsOrders = Nothing
    Set rsAttachmentsQU = Nothing
    Set rsAttachmentsOrders = Nothing
    Set db = Nothing
    Me.Ordered.Value = 0
End Sub

注意事项 #

• 确认表名和字段名：代码中使用的Orderss和Datye是你原代码中的命名，若实际表名为Orders、字段名为Date，请对应修改。
• 该代码通过DAO记录集直接操作附件的二进制数据，确保附件完整迁移。
• 新增了错误处理逻辑，避免操作中断导致数据异常。
• 操作完成后刷新表单，保证界面显示最新数据。

内容的提问来源于stack exchange，提问作者مجید صفائیان