Hi, I am trying to produce a macro that will allow me to extract
attachments from a saved .msg file. The following code works perfectly
unless the attachment is a .zip. I was wondering if anyone had any
ideas as why it does not detect zip attachments and any possible
solutions. Here's the code:
Option Explicit
Sub Extract()
Dim sMessagePath As String
Dim sSavePath As String
Dim OLApp As Outlook.Application
Dim oMessage As Outlook.MailItem
Dim oMsgAttach As Outlook.Attachment
'----------------------------------------------------------
'Get the path for the .msg file
'----------------------------------------------------------
With Application.FileDialog(msoFileDialogFilePicker)
'only allow a single file to be selected
.AllowMultiSelect = False
.Title = "Select Message File"
'Filter the file list to only
'include .msg files
With .Filters
.Clear
.Add "Message Files", "*.msg"
End With
'If the user selects a file
'record the path,
'otherwise quit execution
If .Show = -1 Then
sMessagePath = .SelectedItems(1)
Else
Exit Sub
End If
End With
'----------------------------------------------------------
Get the save path
'----------------------------------------------------------
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Select Save Folder"
If .Show = -1 Then
sSavePath = .SelectedItems(1)
Else
Exit Sub
End If
End With
'----------------------------------------------------------
'Export the attachments
'----------------------------------------------------------
'Create Outlook objects
Set OLApp = New Outlook.Application
Set oMessage = OLApp.CreateItemFromTemplate(sMessagePath)
'Loop through each attachment...
For Each oMsgAttach In oMessage.Attachments
With oMsgAttach
'... save to the destination folder
.SaveAsFile Path:=sSavePath & "\" & .DisplayName
End With
Next oMsgAttach
'Clear object variables
Set OLApp = Nothing
Set oMessage = Nothing
Set oMsgAttach = Nothing
End Sub
Thanks in advance.
P.S. i have had a lot of help on this so my understanding is a little
limited
Bookmarks