How to Quickly Export the Activities of a Specific Contact to Excel in Your Outlook

In Outlook, contact has a separate “Activities” pane, where you can check all items associated with this contact. You may wish to export these activities. But no such a native function supports it. Thus, this post will introduce you a method to realize it.

To check all items related to a specific contact, you can simply access the contact “Activities” page. However, by default, Outlook doesn’t support you to export the activity list. Hence, if you wish to quickly export it, you can use the way shared in the followings.

Quickly Export the Activities of a Specific Contact to Excel

Export the Activities of a Specific Contact to Excel

  1. At the very outset, start your Outlook application.
  2. Then, in its main window, you could press “Alt + F11” key buttons.
  3. After that, a new window called “Microsoft Visual Basic for Applications” will display, where you need to open an unused module or just insert a new one.
  4. Next, you ought to copy the following VBA code into this module.
Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet
Dim objContact As ContactItem

Sub ExportContactActivitiesToExcel()
    Dim objStore As Store
    Dim objPSTFile As Folder
 
    Set objContact = Application.ActiveExplorer.Selection.Item(1)
 
    If Not (objContact Is Nothing) Then
       'Create a new Excel workbook
       Set objExcelApp = CreateObject("Excel.Application")
       Set objExcelWorkbook = objExcelApp.Workbooks.Add
       Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
       objExcelApp.Visible = True
       objExcelWorkbook.Activate
 
       With objExcelWorksheet
            .Cells(1, 1) = "Subject"
            .Cells(1, 1).Font.Bold = True
            .Cells(1, 1).Font.Size = 14
            .Cells(1, 2) = "In Folder"
            .Cells(1, 2).Font.Bold = True
            .Cells(1, 2).Font.Size = 14
       End With
  
       'Process all PST files in your Outlook
       For Each objStore In Application.Session.Stores
           Set objPSTFile = objStore.GetRootFolder
           Call ProcessFolders(objPSTFile.Folders)
       Next
 
       objExcelWorksheet.Columns("A:B").AutoFit
    End If
End Sub

Sub ProcessFolders(ByVal objFolders As Folders)
    Dim objFolder As Folder
    Dim strFilter As String
    Dim objFoundItems As Items
    Dim objItem As Object
    Dim objLink As Link
    Dim objRecipient As recipient
    
    'Process all folders recursively
    For Each objFolder In objFolders
        Select Case objFolder.DefaultItemType
               Case olMailItem
 
                    'Find related emails
                    objFolder.Items.SetColumns ("From, To, CC")
 
                    strFilter = "[From] =" & Chr(34) & objContact.Email1Address & Chr(34) & " OR" & " [To] =" & Chr(34) & objContact.Email1Address & Chr(34) & " OR " & "[CC] =" & Chr(34) & objContact.Email1Address & Chr(34)
 
                    If objContact.Email2Address <> "" Then
                       strFilter = strFilter & " OR [From] =" & Chr(34) & objContact.Email2Address & Chr(34) & " OR" & " [To] =" & Chr(34) & objContact.Email2Address & Chr(34) & " OR" & " [CC] =" & Chr(34) & objContact.Email2Address & Chr(34)
                    End If
 
                    If objContact.Email3Address <> "" Then
                       strFilter = strFilter & " OR [From] =" & Chr(34) & objContact.Email3Address & Chr(34) & " OR" & " [To] =" & Chr(34) & objContact.Email3Address & Chr(34) & " OR" & " [CC] =" & Chr(34) & objContact.Email3Address & Chr(34)
                    End If
 
                    Set objFoundItems = objFolder.Items.Restrict(strFilter)
 
                    'Export to Excel
                    For Each objItem In objFoundItems
                        Call ExportToExcel(objFolder, objItem)
                    Next
 
               'Export related tasks and journals
               Case olTaskItem, olJournalItem
 
                    For Each objItem In objFolder.Items
                        For Each objLink In objItem.links
                            If objLink.Name = objContact.FullName Then
                               Call ExportToExcel(objFolder, objItem)
                            End If
                        Next
                    Next
               'Export related appointments
               Case olAppointmentItem
 
                    For Each objItem In objFolder.Items
                        If objItem.Recipients.Count > 0 Then
                           For Each objRecipient In objItem.Recipients
                               If objRecipient.Address = objContact.Email1Address Or objRecipient.Address = objContact.Email2Address Or objRecipient.Address = objContact.Email3Address Then
                                  Call ExportToExcel(objFolder, objItem)
                               End If
                           Next
                        Else
                           For Each objLink In objItem.links
                               If objLink.Name = objContact.FullName Then
                                  Call ExportToExcel(objFolder, objItem)
                               End If
                           Next
                        End If
                    Next
        End Select
        Call ProcessFolders(objFolder.Folders)
    Next
End Sub
 
Sub ExportToExcel(objCurrentFolder As Folder, objCurrentItem As Object)
    Dim nLastRow As Integer
 
    nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
 
    'Input item's subject as well as current folder path
    objExcelWorksheet.Range("A" & nLastRow) = objCurrentItem.Subject
    objExcelWorksheet.Range("B" & nLastRow) = objCurrentFolder.FolderPath
End Sub

VBA Code - Export the Activities of a Specific Contact to Excel

  1. After that, you could exit the current window.
  2. Subsequently, add the new macro to Quick Access Toolbar as normal.
  3. Finally you can have a try.
  • Firstly, select a contact in your Contacts folder.
  • Then click on the macro button in Quick Access Toolbar.
  • After the macro finishes, you will see a new Excel workbook, in which all of this contact’s activities have been listed out, like the screenshot below:Exported Excel File

Retrieve Corrupt Outlook Data

Outlook is prone to damage though it comes endowed with many functions. So in order to protect your Outlook data, you’d better make regular backups. Moreover, it is prudent to keep a reliable and formidable repair tool handy, like DataNumen Outlook Repair. It can recover PST data like a cork.

Author Introduction:

Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including sql corruption and outlook repair software products. For more information visit www.datanumen.com

Comments are closed.