检查 .msg 文件是否有任何附件答案

【问题标题】：Check if the .msg file has any attachments检查 .msg 文件是否有任何附件
【发布时间】：2022-01-01 11:10:53
【问题描述】：

我有一个包含数千个 .msg 文件的文件夹。我的要求是检查 .msg 文件是否包含附件。

我有以下 VBA 代码，它从 .msg 文件下载附件，但我只需要检查附件是否存在。

Public Sub Extract_Attachments_From_Outlook_Msg_Files()

    Dim outApp As Object
    Dim outEmail As Object
    Dim outAttachment As Object
    Dim msgFiles As String, sourceFolder As String, saveInFolder As String
    Dim fileName As String
    
    msgFiles = ""       'CHANGE - folder location and filespec of .msg files
    saveInFolder = ""         'CHANGE - folder where extracted attachments are saved
    
    If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
    sourceFolder = Left(msgFiles, InStrRev(msgFiles, "\"))
    
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    If outApp Is Nothing Then
        MsgBox "Outlook is not open"
        Exit Sub
    End If
    On Error GoTo 0
    
    fileName = Dir(msgFiles)
    While fileName <> vbNullString
        
        'Open .msg file in Outlook 2003
        'Set outEmail = outApp.CreateItemFromTemplate(sourceFolder & fileName)
        
        'Open .msg file in Outlook 2007+
        Set outEmail = outApp.Session.OpenSharedItem(sourceFolder & fileName)
        
        For Each outAttachment In outEmail.Attachments
            outAttachment.SaveAsFile saveInFolder & outAttachment.fileName
        Next
    
        fileName = Dir
        
    Wend
    
End Sub

【问题讨论】：

您可以在搜索框中使用hasattachments:yes 过滤您的文件夹以查找所有带有附件的电子邮件。通过使用 VBA，您想做什么？统计附件总数？

标签： vba outlook

【解决方案1】：

Outlook 对象模型不允许您访问嵌入的邮件附件，除非您先保存附件 (Attachment.SaveAsFile)，然后使用 Namespace.OpenSharedItem 重新打开 MSG 文件。

如果使用Redemption是一个选项，您可以使用RDOSession.GetMessageFromMsgFile（返回RDOMail对象）打开一个MSG文件，但不需要保存嵌入的消息附件-RDOAttachment .EmbeddedMsg 属性将邮件附件作为RDOMail 对象返回。

【讨论】：