Excel -VB - Opening Microsoft Outlook attachments from saved .msg files (new problem)

[ShootMe]

Hello,

I have a large number of emails all saved in individual files. Each of
these emails contains 2 or more attachments (all excel spreadsheets). I am looking to write a macro in excel whereby the user can select a saved email
and it will automatically open all of the attachments. Any help would
be greatly appreciated.

Thanks in advance,
Rich

[DKenny]

Welcome to the Forums

A couple of questions.

1/ What format are the file saved as?
2/ Have you written any code so far? - if so, plase post it.

[ShootMe]

Thanx for the welcome

The emails I am trying to get the attachments from are all .msg extensions

The attachments themselves are all excel files .xls

I have not written any code as of yet but I will probably start by using a GetFilname application to get the user to chose the email file.

fileToOpen = Application.GetOpenFilename("Outlook item (*.msg), *.msg")
 
If fileToOpen <> False Then
    Workbooks.Open Filename:=fileToOpen
End If

My aim is to open all the attachments from the chosen email so I can further manipulate the individual spreadsheets.

Thanxs for you interest,
Rich

[RobDog888]

Here is one of my code examples on saving an email attachment to the file system using Outlook.

http://www.vbforums.com/showthread.php?t=347353

[DKenny]

Opening MailItems that have been saved as .msg files is really difficult. One easy work around it to create a copy of the file using the CreateItemFromTemplate method of the Outlook application. This makes a copy of the msg file that you can work with in subsequent code.
Here's a procedure that should give you what you need. I've used the FileDialog object rather than the GetOpenFilename method, as it has move flexibility.
Note: I wrote this in Excel, and you will need to add a reference to the Outlook library.

Option Explicit
 
Sub ShootMe()
Dim sMessagePath As String
Dim sSavePath As String
Dim OLApp As Outlook.Application
Dim oMessage As Outlook.MailItem
Dim oMsgAttach As Outlook.Attachment
 
    '----------------------------------------------------------
    'First 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
    
    '----------------------------------------------------------
    'Next, 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
    
    '----------------------------------------------------------
    'Now we need to open the message and 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
            '... saving it 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

[RobDog888]

Isnt that basically the same as my code example. I used CreateItemFromTemplate.

You also need to filter out the invalid characters in the SaveAsFile.

[DKenny]

Rob
Yes its basically the same hack. To be honest, I didn't read all your referenced thread before I posted, as It didn't refer to a saved .msg file.

[RobDog888]

I know it takes time to read all a thread or code example as I am guilty of the same thing from time to time. My link had attached email messages with attachments in them so that code example was specific.

I know about the FileDialog in other Office apps but never had the need for it in Outlook.

Nice touch as always.

[ShootMe]

Thank guys you have been a massive help.

I think I’ll stick around these forums - I'm relearning Visual Basic after a long break and I'm loving the standard to code posted in these forums.

Thanx again guys and seeya around

[ShootMe]

Hi again, I've been using the code that DKenny wrote and it's been working perfectly However recently I discovered that it does not detect .zip files. I included oMessage.Attachments.Count to test an email with a zip attachment and it came up as 0. Any ideas as to why this is and how to fix it? Thanks once again.

[DKenny]

I assume you are using XP, correct? In XP BG & Co decided to make zip files act like folders. I imagine this is why you are seeing this behaviour. Not sure, yet, how to fix it...

[rchawda]

Hi DKenny,

I am referring to this after a long-long time.
I tried this code of yours - it worked great for picking up one .msg file from a folder.
But the user has to run the macro multiple times to extract attachments from all the .msg files in a given folder.
Can you help pls with a modified version of this code, to open all the .msg files from a given folder and extract all the attachments (from each .msg) into another specified folder?
This was perhaps the original requirement of Shootme too!
May be Shootme could manage with the piece of code you shared.

Would be greatfull if you can enhance this code of yours to accomplish the task of extracting the attachments from each and every .msg files stored in a folder in one go (macro to be executed only once).

Regards

Rajesh

Opening MailItems that have been saved as .msg files is really difficult. One easy work around it to create a copy of the file using the CreateItemFromTemplate method of the Outlook application. This makes a copy of the msg file that you can work with in subsequent code.
Here's a procedure that should give you what you need. I've used the FileDialog object rather than the GetOpenFilename method, as it has move flexibility.
Note: I wrote this in Excel, and you will need to add a reference to the Outlook library.

Option Explicit
 
Sub ShootMe()
Dim sMessagePath As String
Dim sSavePath As String
Dim OLApp As Outlook.Application
Dim oMessage As Outlook.MailItem
Dim oMsgAttach As Outlook.Attachment
 
    '----------------------------------------------------------
    'First 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
    
    '----------------------------------------------------------
    'Next, 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
    
    '----------------------------------------------------------
    'Now we need to open the message and 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
            '... saving it 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

[westconn1]

try like

mypath = "c:\test\messages\"     ' change to suit
ssavepath = "c:\test\attachments"
msg = dir(mypath & "*.msg")    ' assumes messages have .msg extention

do while len(msg) > 0   ' exit when no more messages
    Set OLApp = New Outlook.Application
Set oMessage = OLApp.CreateItemFromTemplate(mypath & msg)
   
    'Loop through each attachment...
    For Each oMsgAttach In oMessage.Attachments
   
        With oMsgAttach
            '... saving it to the destination folder
            .SaveAsFile Path:=sSavePath & "\" & .DisplayName
        End With
    Next oMsgAttach
msg = dir     ' get next message
loop

you can either hardcode the folder for messages and attachments or use the filedialog as in the original code, add or remove trailing \ as required