Excel VBA to get email data

ishwaringle

New Member
Joined
Mar 18, 2019
Messages
1
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
 

Some videos you may like

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Brombrough

New Member
Joined
Apr 10, 2017
Messages
49
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,564
Messages
5,596,875
Members
414,106
Latest member
Tigretto

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top