Reputation: 1
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
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