Outlook VBA将完整邮件存入Access附件字段报错及语法问题求助

核心错误分析与解决 #

1. 对象赋值错误 #

原代码Mattach = MyMail.attachments存在两个问题：

• Attachments是集合对象，必须用Set关键字赋值
• 变量类型声明错误：单个附件是Attachment，多个附件的集合是Attachments，需把变量声明改为Dim Mattach As Attachments

2. Access附件字段无法用普通INSERT插入 #

Access的Attachment是特殊类型字段，不能通过拼接SQL语句直接赋值，必须借助ADODB.Recordset操作子记录集来添加附件内容。另外要先把完整邮件保存为.msg临时文件，再存入数据库。

3. 其他细节bug #

• MSender = MyMail.Sender：Sender是对象，需改为MyMail.SenderName（发件人名称）或MyMail.SenderEmailAddress（发件人邮箱），避免对象引用错误
• 日期格式：Access中日期需用#包裹，而非单引号
• 字符串拼接风险：邮件正文/主题含单引号会导致SQL语法错误，建议用记录集操作替代字符串拼接

完整修正代码 #

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    On Error GoTo ErrorHandler ' 启用错误捕获，方便排查问题
    
    ' 定义邮件对象
    Dim MyMail As MailItem
    Set MyMail = Application.Session.GetItemFromID(EntryIDCollection)
    
    ' 只处理主题包含"Proof"的邮件（用Like匹配通配符）
    If MyMail.Subject Like "*Proof*" Then
        Dim MSender As String, MSub As String, MBody As String, Mtime As Date
        MSender = MyMail.SenderEmailAddress ' 改用发件人邮箱，避免对象错误
        MSub = MyMail.Subject
        MBody = MyMail.Body
        Mtime = MyMail.ReceivedTime
        
        ' 步骤1：将当前邮件保存为临时.msg文件
        Dim tempMsgPath As String
        tempMsgPath = Environ("TEMP") & "\" & Format(Now(), "YYYYMMDDHHMMSS") & ".msg"
        MyMail.SaveAs tempMsgPath, olMSG
        
        ' 步骤2：连接Access数据库
        Dim cnx As ADODB.Connection
        Set cnx = New ADODB.Connection
        cnx.Provider = "Microsoft.ACE.OLEDB.12.0"
        cnx.ConnectionString = "\\page\data\NFInventory\groups\CID\CID Database\Test Database\dbBE\CID_be.accdb"
        cnx.Open
        
        ' 步骤3：插入基础数据
        Dim rs As ADODB.Recordset
        Set rs = New ADODB.Recordset
        rs.Open "SELECT * FROM ITtbl WHERE 1=0", cnx, adOpenKeyset, adLockOptimistic
        
        ' 添加新记录
        rs.AddNew
        rs("[From]") = MSender
        rs("[Subject]") = MSub
        rs("[Body]") = MBody
        rs("[Received]") = Mtime
        rs.Update
        
        ' 步骤4：为新记录的Attachment字段添加.msg附件
        Dim rsAttach As ADODB.Recordset
        Set rsAttach = rs.Fields("Attachment").Value ' 获取附件字段的子记录集
        rsAttach.AddNew
        rsAttach("FileData").LoadFromFile tempMsgPath ' 加载临时.msg文件
        rsAttach.Update
        rsAttach.Close
        
        ' 清理资源
        rs.Close
        cnx.Close
        Kill tempMsgPath ' 删除临时文件
        
        Set rsAttach = Nothing
        Set rs = Nothing
        Set cnx = Nothing
    End If
    
    Exit Sub
ErrorHandler:
    MsgBox "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description
    ' 清理临时文件（如果存在）
    If Dir(tempMsgPath) <> "" Then Kill tempMsgPath
End Sub

关键说明 #

• 临时文件处理：通过MyMail.SaveAs把完整邮件存为本地.msg文件，这是存入Access附件字段的必要前提
• 附件字段操作逻辑：Access的Attachment字段本质是子记录集，需通过Fields("Attachment").Value获取子记录集，再用LoadFromFile加载文件内容
• 错误防护：添加错误捕获确保临时文件被清理，避免垃圾文件残留
• 通配符匹配：用Like "*Proof*"替代原代码的=，才能正确匹配包含"Proof"的主题

内容的提问来源于stack exchange，提问作者Deke