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
