Extract outlook message body text with VBA from Excel

Question

I have a huge number of Outlook .msg and Outlook .eml files saved to a shared network folder (ie outside of Outlook). I am trying to write some VBA in Excel that extracts the Subjects，Sender, CC, Receiver, SentTime, SentDate, message body text from each file and import these info to Excel cells orderly

Subject Sender CC Receiver SentTime SentDate

Re:.. Mike Jane Tom 12:00:00 23 Jan 2013

I've done a similar thing with word documents but I'm struggling to 'get at' the text in the .msg files.

So far I have the code below. I like to think I'm on the right track at least, but I'm stuck at the line where I'm trying to set up a reference to the msg file. Any advice will be appreciated...

Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem

Set MyOutlook = New Outlook.Application


Set MyMail = 

Dim FileContents As String

FileContents = MyMail.Body

Regards

Zack Kay Zack Kay · Accepted Answer · 2013-04-23T15:54:45

so I've been able to get it working with .msg files saved outside of outlook. However, as I don't have access to Outlook Express I have no way of saving any .eml files at the moment. Here's a Sub I've come up with that will insert Subject,Sender,CC,To, and SendOn into an excel worksheet starting at row 2 column 1 (assuming a header row at row 1):

Sub GetMailInfo(Path As String)

    Dim MyOutlook As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim x As Namespace

    Set MyOutlook = New Outlook.Application
    Set x = MyOutlook.GetNamespace("MAPI")

    FileList = GetFileList(Path + "*.msg")


    row = 1

    While row <= UBound(FileList)

        Set msg = x.OpenSharedItem(Path + FileList(row))

        Cells(row + 1, 1) = msg.Subject
        Cells(row + 1, 2) = msg.Sender
        Cells(row + 1, 3) = msg.CC
        Cells(row + 1, 4) = msg.To
        Cells(row + 1, 5) = msg.SentOn


        row = row + 1
    Wend

End Sub

which uses the GetFileList function as defined below (thanks to spreadsheetpage.com)

Function GetFileList(FileSpec As String) As Variant
'   Taken from http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String

    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound

'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
    NoFilesFound:
        GetFileList = False
End Function

Should be fairly straightforward, let me know if you need any more explanation.

Edit: You'll also have to add a reference to the outlook library

HTH!

Z

Extract outlook message body text with VBA from Excel

3 Answers