VBA code to extract metadata from .msg files

VBA code to extract metadata from .msg files

March 31, 2018

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
 

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