top of page
Search
    • Mar 31, 2018

VBA code to extract metadata from .msg files


If you have a set of .msg files you can extract the metadata from the files using the below VBA code, posted here.

First begin, by opening Visual Basic and selecting the Microsoft Object Library in Tools . . .. References

In the vba code enter the path for the folder which contains the .msg files.

After you run the subject; author; recipient; copyee; and date fields will be extracted to separate columns in a worksheet.

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:\FooFolder\email\" 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


bottom of page