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.
- Auto CC/BCC by rules when sending email; Auto Forward Multiple Emails by rules; Auto Reply without exchange server, and more automatic features...
- BCC Warning - show message when you try to reply all if your mail address is in the BCC list; Remind When Missing Attachments, and more remind features...
- Reply (All) With All Attachments in the mail conversation; Reply Many Emails at once; Auto Add Greeting when reply; Auto Add Date&Time into subject...
- Attachment Tools: Auto Detach, Compress All, Rename All, Auto Save All... Quick Report, Count Selected Mails, Remove Duplicate Mails and Contacts...
- More than 100 advanced features will solve most of your problems in Outlook 2021 - 2010 or Office 365. Full features 60-day free trial.
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 \Inbox\A and \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.
Best Office Productivity Tools
Kutools for Outlook - Over 100 Powerful Features to Supercharge Your Outlook
📧 Email Automation: Out of Office (Available for POP and IMAP) / Schedule Send Emails / Auto CC/BCC by Rules When Sending Email / Auto Forward (Advanced Rules) / Auto Add Greeting / Automatically Split Multi-Recipient Emails into Individual Messages ...
Over 100 Features Await Your Exploration! Click Here to Discover More.