Sometimes, you may want to export the recipients of multiple Outlook emails to an Excel worksheet. In comparison to using inbuilt “Export” tool, it is suggested for you to utilize the method introduced in this article. It is much more convenient.
When you receive some emails which are not only sent to you but also to multiple other recipients, you may want to export these recipients. In general, you can use the internal “Export” feature in Outlook. But it is a bit tedious and cumbersome. For instance, it only allows you to process all emails in a folder instead of selected emails. Therefore, here we’ll teach you another way, which uses VBA code.
Export All Recipients of Multiple Emails to an Excel Worksheet
- At first, launch VBA editor in Outlook by referring to “How to Run VBA Code in Your Outlook“.
- Then, add the reference to “MS Excel Object Library” as per “How to Add an Object Library Reference in VBA“.
- After that, copy the code into a blank module.
Sub ExportRecipientsToExcelSheet() Dim objSelection As Outlook.Selection Dim objDictionary As Object Dim objMail As Outlook.MailItem Dim objRecipient As Outlook.Recipient Dim strEmailAddress, strName As String Dim objExcelApp As Excel.Application Dim objExcelWorkbook As Excel.Workbook Dim objExcelWorksheet As Excel.Worksheet Dim varEmailAddresses As Variant Dim nLastRow As Integer Set objSelection = Outlook.Application.ActiveExplorer.Selection If Not (objSelection Is Nothing) Then 'Use Dictionary to avoid duplicates Set objDictionary = CreateObject("Scripting.Dictionary") For Each objItem In objSelection If TypeOf objItem Is MailItem Then Set objMail = objItem For Each objRecipient In objMail.Recipients If objRecipient <> Session.CurrentUser Then strEmailAddress = objRecipient.Address If objDictionary.Exists(strEmailAddress) Then objDictionary.Item(strEmailAddress) = objDictionary.Item(strEmailAddress) + 1 Else objDictionary.Add strEmailAddress, 1 End If End If Next End If Next Set objExcelApp = CreateObject("Excel.Application") objExcelApp.Visible = True Set objExcelWorkbook = objExcelApp.Workbooks.Add Set objExcelWorksheet = objExcelWorkbook.Sheets(1) With objExcelWorksheet .Cells(1, 1) = "Name" .Cells(1, 1).Font.Bold = True .Cells(1, 2) = "Email Address" .Cells(1, 2).Font.Bold = True End With varEmailAddresses = objDictionary.Keys For i = LBound(varEmailAddresses) To UBound(varEmailAddresses) nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1 strName = Split(varEmailAddresses(i), "@")(0) strName = UCase(Left(strName, 1)) & LCase(Right(strName, Len(strName) - 1)) With objExcelWorksheet .Cells(nLastRow, 1) = strName .Cells(nLastRow, 2) = varEmailAddresses(i) End With Next objExcelWorksheet.Columns("A:B").AutoFit End If End Sub
- Later, exit the current editor window.
- Subsequently, access “Outlook Options” to add this macro to Quick Access Toolbar.
- Finally, take the following steps to try this macro.
- For a start, select multiple emails.
- Then, hit the macro button in Quick Access Toolbar.
- When macro completes, you will get a new Excel worksheet, as shown in the figure below.
Eliminate Chances of Outlook Data Loss
It is sure that no one is willing to suffer Outlook data loss. The same must hold true for you. Under this circumstance, you will be required to take some essential actions to eliminate the chances of Outlook data loss. For instance, you ought to make regular Outlook data backups. Also, you have to keep a remarkable Outlook recovery utility, such as DataNumen Outlook Repair. It can repair Outlook file in a jiffy.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including sql fix and outlook repair software products. For more information visit www.datanumen.com