Microsoft outlook is a useful software system from Microsoft. People primarily use it to manage their emails. In addition to managing emails, Outlook software can be used to manage tasks, take notes and for few other functions. Outlook software also gives an option to save emails to local drive. So you can save your emails to your local drive as a .msg file. In this post I will explain to you how to extract information from such a .msg file to an Excel sheet using VBA. This will be really helpful if you want to extract information from lots of emails. Assume you want to get the following information from the email.
You can use the following subroutine to extract the above information.
|
Sub ExtractInfo() Dim WS As Worksheet Dim i As Long Dim olApp As Outlook.Application Dim mailDoc As Outlook.MailItem Set WS = Worksheets("Sheet1") Set olApp = CreateObject("Outlook.Application") Set mailDoc = olApp.Session.OpenSharedItem("C:\Users\EVS\Documents\email test\test.msg") WS.Range("A2").Value = mailDoc.SentOn WS.Range("B2").Value = mailDoc.Sender WS.Range("C2").Value = mailDoc.SenderEmailAddress WS.Range("D2").Value = mailDoc.Body WS.Range("E2").Value = mailDoc.To WS.Range("F2").Value = mailDoc.Attachments.Count If mailDoc.Attachments.Count > 0 Then For j = 1 To mailDoc.Attachments.Count AttachmentNames = AttachmentNames & ", " & mailDoc.Attachments.Item(j).DisplayName Next j End If AttachmentNames = Replace(AttachmentNames, ",", "", 1, 1) WS.Range("G2").Value = AttachmentNames mailDoc.Close False olApp.Quit Set mailDoc = Nothing Set olApp = Nothing End Sub |
Remember to add reference to “Microsoft outlook object library”. Otherwise you will get an error like this.
Also replace the file path of the .msg file with your file path. Here is a sample result of the above macro.
In the above code, I have given the path and file name inside the code like this.
| Set mailDoc = olApp.Session.OpenSharedItem("C:\Users\EVS\Documents\email test\test.msg") |
However if you want you can input the path and file name from the Excel sheet as well.
Then we can use this code instead of the above line.
|
Dim SPathAndFileName As String SPathAndFileName = WS.Range("B2").Value Set mailDoc = olApp.Session.OpenSharedItem(SPathAndFileName) |
Next I will explain about the code related to the attachment names.
First we check whether there is at least one attachment.
| If mailDoc.Attachments.Count > 0 Then |
If there are attachments then we use the “For Next” loop to go through each attachment and get their names.
|
For j = 1 To mailDoc.Attachments.Count AttachmentNames = AttachmentNames & ", " & mailDoc.Attachments.Item(j).DisplayName Next j |
Above For Next loop generates an additional comma at the beginning. So we can remove that using the following line.
| AttachmentNames = Replace(AttachmentNames, ",", "", 1, 1) |
In the above code we have used the “Early binding” method. That’s why we need to add reference to “Microsoft outlook object library”. However if you don’t like to add reference to the type library then you can develop the code using the “Late binding” technique as follows.
|
Sub ExtractInfo() Dim WS As Worksheet Dim i As Long Dim olApp As Object Dim mailDoc As Object Set WS = Worksheets("Sheet1") Set olApp = CreateObject("Outlook.Application") Set mailDoc = olApp.Session.OpenSharedItem("C:\Users\EVS\Documents\email test\test.msg") WS.Range("A2").Value = mailDoc.SentOn WS.Range("B2").Value = mailDoc.Sender WS.Range("C2").Value = mailDoc.SenderEmailAddress WS.Range("D2").Value = mailDoc.Body WS.Range("E2").Value = mailDoc.To WS.Range("F2").Value = mailDoc.Attachments.Count If mailDoc.Attachments.Count > 0 Then For j = 1 To mailDoc.Attachments.Count AttachmentNames = AttachmentNames & ", " & mailDoc.Attachments.Item(j).DisplayName Next j End If AttachmentNames = Replace(AttachmentNames, ",", "", 1, 1) WS.Range("G2").Value = AttachmentNames mailDoc.Close False olApp.Quit Set mailDoc = Nothing Set olApp = Nothing End Sub |
So now you don’t need to add reference to “Microsoft outlook object library”.
