Excel Macro to Collect Outlook Metadata

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]