Extracting Outlook messages metadata to Excel spreadsheet

[peddy00]

Hi,

I have 26 emails in a folder with path C:\Users\Peter\Desktop\New folder, all with the file extension .msg. I'd like to extract the sender, recipient, Cc, and other data from the emails, and set them in a spreadsheet. I found something that I thought would be helpful at a different forum (though, I don't need the body of the message in my spreadsheet), but I have a few problems with it.

First, how is that macro supposed to be called? When I'm in the VBA editor, and hit F5, the macro doesn't start.

Second, I can't see where I'm supposed to put the specific path I want to use into the code.

Third, just wanting to see what would happen, I deleted Path As String from the first line of the macro, then run the code, but the compiler gives me an error, saying that MyOutlook As Outlook.Application is a "User-defined type not defined."

Anyway, all I really care about is getting To, Cc, From, SentOn, and, if possible, a list of any attachments in the emails, I don't need the macro referred to above to work.

If this isn't clear, please feel free to ask for clarification. Thanks.

Peter

 

[Comfy]

I've updated the example you posted:

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:\Users\Peter\Desktop\New folder\"
    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

Once of the reasons it may not have run for you is because it needs to be given the Path value.
Without this the sub would not work. (it has been written to be called from another sub)

 

[peddy00]

Thanks. That looks great.
Peter

 

[peddy00]

Actually, I just tried it, and I'm still getting the same error as I was getting above. It's saying that it doesn't like the data type Outlook.Application. Thoughts as to why that is?

Peter

 

[peddy00]

Not sure if this helps, but if I comment out the first declaration, the compiler has a problem with the Outlook.MailItem data type. If I comment out the second declaration, as well, the compiler has a problem with the Namespace data type. If I comment out that declaration, obviously the macro eventually fails, but it makes it past the String and Long data type declarations.

Peter

 

[peddy00]

Still hoping someone can help me, so I'm replying just to bump this thread to the top of the queue.

 

[Comfy]

Apologies, I didn't see the email.

In the VBA editor click References and make sure you have a reference to Microsoft Outlook object Library

 

[peddy00]

Thank you for helping. It was really helpful for you to point out the Outlook reference in VBA.

The macro ran and did exactly what I wanted it to do. Since then, I've added one more element to the code. I'm trying to get it to tell me the size of the msg file. I added a line

Cells(Row + 1, 7) = msg.Size

It's compiling, but for each message, it is giving a size of exactly zero. Given that Microsoft says that the message size should be returned in bytes, it should be a decent size number, not zero. Any idea how to fix this?

As I said, I've tweaked the code a little, so I'm going display the macro in its current shape:

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:\Users\Peter\Desktop\New folder\"
    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.SenderName
        Cells(Row + 1, 3) = msg.SenderEmailAddress
        Cells(Row + 1, 4) = msg.CC
        Cells(Row + 1, 5) = msg.To
        Cells(Row + 1, 6) = msg.SentOn
        Cells(Row + 1, 7) = msg.Size
        If msg.Attachments.Count > 0 Then
            For i = 1 To msg.Attachments.Count
                Cells(Row + 1, 7 + i) = msg.Attachments.Item(i).FileName
            Next i
        End If
        
        Row = Row + 1
    Wend

End Sub

 

[Comfy]

Now that is bizarre!
While debugging and stepping through the code the file size displays correctly but when running the code it displays a zero.
I tried adding a delay but that didn't work so have instead used FileLen() FileLen Function

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 = "Removed my Directory\"
    FileList = GetFileList(Path + "*.msg")


    Row = 1


    While Row <= UBound(FileList)
    
        Set msg = x.OpenSharedItem(Path + FileList(Row))
        Application.Wait (True)
        Cells(Row + 1, 1) = msg.Subject
        Cells(Row + 1, 2) = msg.SenderName
        Cells(Row + 1, 3) = msg.SenderEmailAddress
        Cells(Row + 1, 4) = msg.CC
        Cells(Row + 1, 5) = msg.To
        Cells(Row + 1, 6) = msg.SentOn
        Cells(Row + 1, 7) = FileLen(Path + FileList(Row)) 'msg.Size
        If msg.Attachments.Count > 0 Then
            For i = 1 To msg.Attachments.Count
                Cells(Row + 1, 7 + i) = msg.Attachments.Item(i).Filename
            Next i
        End If
        Row = Row + 1
   
    Wend


End Sub

I wonder if any of the mods or other users know why this is?

 

[peddy00]

Thanks for all the patient help, Comfy. I now have all the information I need.

Peter