Excel Macro to Collect Outlook Metadata

Excel Macro to Collect Outlook Metadata

December 9, 2015

An Excel macro posted to this site, http://www.mrexcel.com/forum/excel-questions/707690-extracting-outlook-messages-metadata-excel-spreadsheet.html   can be used to export metadata from Outlook .msg files to an Excel spreadsheet.     Here's how you do it:

 

1. Begin by saving email messages in the .msg format in a single folder.   [See Fig. 1 below].

 

2. In Visual Basic, go to Tools . . . References and make sure you have the Microsoft Outlook 14.0 Object Library checked off, as well as the other options for Outlook. [See Fig. 2 below].

 

3. Go to the Workbook for your PERSONAL.xlsb file [see the Tip of the Night for October 25, 2015], right click and select Insert . . . Module. 

 

Paste this macro into the new Module.   {See Fig. 3 below]  You need to enter the file path for the folder you created.   See the entry in blue. 

 

Sub GetMailInfo()


    Dim MyOutlook As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim x As Namespace
    Dim Path As String
    Dim i As Long


    Set MyOutlook = New Outlook.Application
    Set x = MyOutlook.GetNamespace("MAPI")
    
    Path = "C:\excel email md\"
    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
        If msg.Attachments.Count > 0 Then
            For i = 1 To msg.Attachments.Count
                Cells(Row + 1, 5 + i) = msg.Attachments.Item(i).FileName
            Next i
        End If


        Row = Row + 1
    Wend


End Sub
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

 

 

 

4.  Run the macro and the basic meta fields will be exported to the first worksheet.   [See Fig. 4]

 

 

 

 

 

 

 

Please reload

Contact Me With Your Litigation Support Questions:

seankevinoshea@hotmail.com

  • Twitter Long Shadow

© 2015 by Sean O'Shea . Proudly created with Wix.com