# Excel VBA to get email data



## ishwaringle (Mar 18, 2019)

Hi, 

I am urgently looking for an excel VBA (not an outlook VBA) to extract email data such as Sender's name, Received time, sent time and all attachments name in a excel. These emails (.msg) are saved on an input folder on my desktop. I used GetMailInfo code but it was giving type mismatch error.

Any help on this would be greatly appreciated.

Thanks


----------



## Brombrough (Mar 20, 2019)

Hi ishwaringle,

If using the following VBA code remember to include the 2 following Tools References in your VBA
      a) Microsoft Outlook ??.? Object Library
      B) Microsoft Scripting Runtime

Hope this is what you want.

Good Luck and Enjoy.





Sub GetMSG()
   ListFilesInFolder "C:\Emails", False
End Sub




Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim strFile, strFileType, strAttach As String
    Dim openMsg As MailItem


    Dim objAttachments As Outlook.Attachments
    Dim i As Long
    Dim lngCount As Long
    Dim strFolderpath As String


    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)


    For Each FileItem In SourceFolder.Files


        strFile = FileItem.Name

        ' This code looks at the last 4 characters in a filename
        ' If we wanted more than .msg, we'd use Case Select statement
        strFileType = LCase$(Right$(strFile, 4))
        If strFileType = ".msg" Then

            Set openMsg = Outlook.Application.CreateItemFromTemplate(FileItem.Path)

            'do whatever
            Debug.Print "Sent to               " & openMsg.To
            Debug.Print "CC to                 " & openMsg.CC
            Debug.Print "Received Date/Time    " & openMsg.ReceivedTime
            Debug.Print "Senders Name          " & openMsg.SenderName
            Debug.Print "Sent Date/Time        " & openMsg.SentOn

            Set objAttachments = openMsg.Attachments
            lngCount = objAttachments.Count

            If lngCount > 0 Then

                For i = lngCount To 1 Step -1

                ' Get the file name.
                Debug.Print "Attachements No " & i & "     " & objAttachments.Item(i).Filename
                strAttach = objAttachments.Item(i).Filename

                ' Combine with the path to the Temp folder.
                strAttach = strFolderpath & strAttach

                Next i
            End If
            openMsg.Close olDiscard

            Set objAttachments = Nothing
            Set openMsg = Nothing

            ' end do whatever
        End If
    Next FileItem

    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
      Next SubFolder
    End If


    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing


End Sub


----------

