To post as a guest, your comment is unpublished.· 2 months agoIn the ExporttoExcel sub you can add the body
'Write Excel Column Headers
.Cells(1, 1) = "Subject"
.Cells(1, 2) = "Received"
.Cells(1, 3) = "Sender"
.Cells(1, 4) = "Body"
intRow = 2
For Each olkMsg In olkFld.Items
'Only export messages, not receipts or appointment requests, etc.
If olkMsg.Class = olMail Then
'Add a row for each field in the message you want to export
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells(intRow, 3) = GetSMTPAddress(olkMsg, intVersion)
excWks.Cells(intRow, 4) = olkMsg.Body
intRow = intRow + 1
To post as a guest, your comment is unpublished.· 4 months agoHi Montaser,
The VBA script runs based on Outlook’s Export feature which doesn’t support exporting message content when bulk exporting emails from a mail folder. Therefore, this VBA script cannot export message content too.
How to export emails from multiple folders/subfolders to excel in Outlook?
When exporting a folder with the Import and Export wizard in Outlook, it does not support the Include Subfolders option if you export the folder to CSV file. However, it will be quite time-consuming and tedious to export each folder to CSV file and then convert it to Excel workbook manually. Here, this article will introduce a VBA to quickly export multiple folders and subfolders to Excel workbooks at ease.
Office Tab: Enable Tabbed Editing and Browsing in Office, Just Like Chrome, Firefox, IE 8/9/10.
Classic Menu: Bring Old Menus and Toolbars Back to Office 2007, 2010, 2013, 2016 and 2019.
Please follow below steps to export emails from multiple folders or subfolders to Excel workbooks with VBA in Outlook.
1. Press Alt + F11 keys to open the Microsoft Visual Basic for Applications window.
2. Click Insert > Module, and then paste below VBA code into the new Module window.
VBA: Export emails from multiple folders and subfolders to Excel
Const MACRO_NAME = "Export Outlook Folders to Excel" Sub ExportMain() ExportToExcel "destination_folder_path\A.xlsx", "your_email_accouny\folder\subfolder_1" ExportToExcel "destination_folder_path\B.xlsx", "your_email_accouny\folder\subfolder_2" MsgBox "Process complete.", vbInformation + vbOKOnly, MACRO_NAME End Sub Sub ExportToExcel(strFilename As String, strFolderPath As String) Dim olkMsg As Object Dim olkFld As Object Dim excApp As Object Dim excWkb As Object Dim excWks As Object Dim intRow As Integer Dim intVersion As Integer If strFilename <> "" Then If strFolderPath <> "" Then Set olkFld = OpenOutlookFolder(strFolderPath) If TypeName(olkFld) <> "Nothing" Then intVersion = GetOutlookVersion() Set excApp = CreateObject("Excel.Application") Set excWkb = excApp.Workbooks.Add() Set excWks = excWkb.ActiveSheet 'Write Excel Column Headers With excWks .Cells(1, 1) = "Subject" .Cells(1, 2) = "Received" .Cells(1, 3) = "Sender" End With intRow = 2 For Each olkMsg In olkFld.Items 'Only export messages, not receipts or appointment requests, etc. If olkMsg.Class = olMail Then 'Add a row for each field in the message you want to export excWks.Cells(intRow, 1) = olkMsg.Subject excWks.Cells(intRow, 2) = olkMsg.ReceivedTime excWks.Cells(intRow, 3) = GetSMTPAddress(olkMsg, intVersion) intRow = intRow + 1 End If Next Set olkMsg = Nothing excWkb.SaveAs strFilename excWkb.Close Else MsgBox "The folder '" & strFolderPath & "' does not exist in Outlook.", vbCritical + vbOKOnly, MACRO_NAME End If Else MsgBox "The folder path was empty.", vbCritical + vbOKOnly, MACRO_NAME End If Else MsgBox "The filename was empty.", vbCritical + vbOKOnly, MACRO_NAME End If Set olkMsg = Nothing Set olkFld = Nothing Set excWks = Nothing Set excWkb = Nothing Set excApp = Nothing End Sub Public Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder Dim arrFolders As Variant Dim varFolder As Variant Dim bolBeyondRoot As Boolean On Error Resume Next If strFolderPath = "" Then Set OpenOutlookFolder = Nothing Else Do While Left(strFolderPath, 1) = "\" strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1) Loop arrFolders = Split(strFolderPath, "\") For Each varFolder In arrFolders Select Case bolBeyondRoot Case False Set OpenOutlookFolder = Outlook.Session.Folders(varFolder) bolBeyondRoot = True Case True Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder) End Select If Err.Number <> 0 Then Set OpenOutlookFolder = Nothing Exit For End If Next End If On Error GoTo 0 End Function Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String Dim olkSnd As Outlook.AddressEntry Dim olkEnt As Object On Error Resume Next Select Case intOutlookVersion Case Is < 14 If Item.SenderEmailType = "EX" Then GetSMTPAddress = SMTPEX(Item) Else GetSMTPAddress = Item.SenderEmailAddress End If Case Else Set olkSnd = Item.Sender If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then Set olkEnt = olkSnd.GetExchangeUser GetSMTPAddress = olkEnt.PrimarySmtpAddress Else GetSMTPAddress = Item.SenderEmailAddress End If End Select On Error GoTo 0 Set olkPrp = Nothing Set olkSnd = Nothing Set olkEnt = Nothing End Function Function GetOutlookVersion() As Integer Dim arrVer As Variant arrVer = Split(Outlook.Version, ".") GetOutlookVersion = arrVer(0) End Function Function SMTPEX(olkMsg As Outlook.MailItem) As String Dim olkPA As Outlook.propertyAccessor On Error Resume Next Set olkPA = olkMsg.propertyAccessor SMTPEX = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E") On Error GoTo 0 Set olkPA = Nothing End Function
3. Please adjust the above VBA code as you need.
(1) Replace destination_folder_path in above code with the folder path of destination folder you will save the exported workbooks in, such as C:\Users\DT168\Documents\TEST.
(2) Replace your_email_accouny\folder\subfolder_1 and your_email_accouny\folder\subfolder_2 in above code with the folder paths of subfolders in Outlook, such as Kelly@extendoffice.com\Inbox\A and Kelly@extendoffice.com\Inbox\B
4. Press the F5 key or click the Run button to run this VBA. And then click the OK button in the popping out Export Outlook Folders to Excel dialog box. See screenshot:
And now emails from all specified subfolders or folders in above VBA code are exported and saved into Excel workbooks.
Recommended Productivity Tools
- Complicated and repeated operations can be done a one-time processing in seconds.
- Forward multiple emails individually with one-click, and auto forward by rules.
- Auto CC/BCC every sending email and easy for customizing rules, and auto reply without requiring exchange server.
- Powerful junk emails filter, remove duplicate emails, reply with attachment, bunch of one-click operations, and so on...
- 60-day unlimited free trial. 60-day money back guarantee. 2 years free upgrade and support. Buy once, use forever.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
To post as a guest, your comment is unpublished.· 11 months agohello dear, every thing working well many thanks but the body is not exported, how can i export email body too, the excel file has just (Subject, Received, and Sender), if you can update me with it will solve a huge matter in my business many thanks again
To post as a guest, your comment is unpublished.· 1 years agoHow do I get this to automatically recurse into subfolders?