Hi, i have a working macro which exports all emails from an inbox and all sub folders. I want to also add the Sender Name.
Here is the piece of the code
Would be thankful forever if someone tells me where to add the info so it exports emails with sender name.
Thank you!
Here is the piece of the code
Would be thankful forever if someone tells me where to add the info so it exports emails with sender name.
Thank you!
>>> use code - tags <<<
Code:
Dim oitem As Outlook.MailItem
Dim justitem As Object
Sub EmailAddress_subfolder()
msgred = MsgBox("Please note: depending on how many Emails are in your folders, this might take some time to run. " + vbCrLf + "Are you sure you want to continue ?", vbQuestion + vbYesNo, "TheTechieGuy.com - Export Address:")
If msgred = 7 Then
Exit Sub
End If
'create the folder if it doesnt exists:
Dim fso, ttxtfile, txtfile, WheretosaveFolder
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders
Set fso = CreateObject("Scripting.FileSystemObject")
'MsgBox objFolders("mydocuments")
ttxtfile = objFolders("mydocuments")
If fso.FolderExists(ttxtfile & "\EmailAddressExport") = False Then
Set txtfile = fso.CreateFolder(ttxtfile & "\EmailAddressExport")
End If
Set txtfile = Nothing
If fso.FileExists(ttxtfile & "\EmailAddressExport\Outputfile.txt") = False Then
Set txtfile = fso.CreateTextFile(ttxtfile & "\EmailAddressExport\Outputfile.txt")
Else
fso.DeleteFile (ttxtfile & "\EmailAddressExport\Outputfile.txt")
Set txtfile = fso.CreateTextFile(ttxtfile & "\EmailAddressExport\Outputfile.txt")
End If
Set txtfile = Nothing
Set fso = Nothing
Dim mycounter As Integer
Dim olapp As Outlook.Application
Dim olappns As Outlook.NameSpace
Dim oinbox As Outlook.Folder
Dim oFolder As Outlook.MAPIFolder
Set olapp = New Outlook.Application
Set olappns = olapp.GetNamespace("MAPI")
Set oinbox = olappns.GetDefaultFolder(olFolderInbox)
Set oinbox = olappns.PickFolder
If TypeName(oinbox) = "Nothing" Then
MsgBox "Please select the Folder you would like to export", vbInformation, "TheTechieguy.com - Export Address:"
Exit Sub
End If
If oinbox = "Calendar" Then
MsgBox "Note: do not select Calendar folders", vbCritical, "TheTechieguy.com - Export Address:"
Exit Sub
End If
If oinbox = "Contacts" Then
MsgBox "Note: do not select Contact folder", vbCritical, "TheTechieguy.com - Export Address:"
Exit Sub
End If
Dim myccounter As Integer
Dim InboxMsg As Object
Dim Inbox As Outlook.Folder
'For Each oitem In oinbox.Items
For Each InboxMsg In oinbox.Items
If InboxMsg.Class = olMail Then 'if it is a mail item
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtfile = fso_OpenTextFile(ttxtfile & "\EmailAddressExport\Outputfile.txt", 8)
txtfile.Write (InboxMsg.SenderEmailAddress) & vbCrLf
txtfile.Close
Set fso = Nothing
'MsgBox "Mail Subject -> " & oitem.Subject
'MsgBox "Sender Email Address -> " & oitem.SenderEmailAddress
'MsgBox "Sender Name -> " & oitem.SenderName
'MsgBox "Mail Body -> " & oitem.Body
'MsgBox "Recived Date -> " & oitem.ReceivedTime
'MsgBox oinbox.Name
'MsgBox oinbox.FolderPath
End If
Next
For Each oFolder In oinbox.Folders
Call subfolders_go(oFolder)
Next
MsgBox "Exported Emails are all done !" + vbCrLf + "File is located in My Documents" + vbCrLf + "in a folder called: EmailAddressExport", vbInformation, "TheTechieguy.com - Export Address:"
End Sub
Private Sub subfolders_go(oParent As Outlook.Folder)
Dim oFolder1 As Outlook.MAPIFolder
'For Each oitem In oParent.Items
'If oitem.Class = olMail Then
Dim InboxMsg As Object
Dim Inbox As Outlook.Folder
'For Each oitem In oinbox.Items
For Each InboxMsg In oParent.Items
If InboxMsg.Class = olMail Then 'if it is a mail item
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders
Set fso = CreateObject("Scripting.FileSystemObject")
ttxtfile = objFolders("mydocuments")
Set txtfile = fso_OpenTextFile(ttxtfile & "\EmailAddressExport\Outputfile.txt", 8)
txtfile.Write (InboxMsg.SenderEmailAddress) & vbCrLf
txtfile.Close
Set fso = Nothing
'MsgBox "Mail Subject -> " & oitem.Subject
'MsgBox "Sender Email Address -> " & oitem.SenderEmailAddress
'MsgBox "Sender Name -> " & oitem.SenderName
'MsgBox "Mail Body -> " & oitem.Body
'MsgBox "Recived Date -> " & oitem.ReceivedTime
'MsgBox oParent.Name
'MsgBox oParent.FolderPath
End If
Next
If (oParent.Folders.Count > 0) Then
For Each oFolder1 In oParent.Folders
Call subfolders_go(oFolder1)
Next
End If
End Sub