Check if the .msg file has any attachments

I have a folder with thousands of .msg files. My requirement is to check whether the .msg files contain an attachment.

I have the below VBA code which downloads the attachments from .msg files but I just need to check the attachment's existence.

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

Upvotes: 0

Views: 481

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66286

Outlook Object Model won't let you access embedded message attachments unless you save the attachment first (Attachment.SaveAsFile) and then reopen the MSG file using Namespace.OpenSharedItem.

If using Redemption is an option (I am its author), you can use RDOSession.GetMessageFromMsgFile (return RDOMail object) to open an MSG file, but there is no need to save the embedded message attachments - RDOAttachment.EmbeddedMsg property returns the message attachment as RDOMail object.

Upvotes: 0

Related Questions