How to Quickly Export the Contact Email Addresses in a Specific Domain via Outlook VBA

If you wish to extract the contact email addresses in a specific domain to a plain text file, you can make use of the intelligent method shared in this article. It can allow you to accomplish this task simply via one click.

Outlook supports users to add 3 email addresses to one contact. Thus, you may fill in more than one email address to your contacts. And the domains of each email address may be different. Now, if you would like to batch export a list of the email addresses in a specific domain, you can read on. Here, we’ll introduce a way to quickly get it.

Export the Contact Email Addresses in a Specific Domain

1. For a start, access VBA editor in Outlook by referring to “How to Run VBA Code in Your Outlook“.
2. Then, copy the following VBA code into a project or a module.

Dim strDomain As String
Dim objFileSystem As Object
Dim strTextFile As String
Dim objTextFile As Object

Sub ExportListOfEmailAddressesInSpecificDomain()
    Dim objStore As Store
    Dim objFolder As folder
 
    strDomain = InputBox("Enter domain:", , "@datanumen.com")
 
    If Len(strDomain) <> 0 Then
       strTextFile = "E:\Contact Email Addresses.txt"
       Set objFileSystem = CreateObject("Scripting.FileSystemObject")
       Set objTextFile = objFileSystem.CreateTextFile(strTextFile, True)
 
       For Each objStore In Application.Session.Stores
           For Each objFolder In objStore.GetRootFolder.Folders
               If objFolder.DefaultItemType = olContactItem Then
                  Call ProcessFolders(objFolder)
               End If
           Next
       Next
 
       objTextFile.Close
       Shell ("notepad.exe " & strTextFile)
    End If
End Sub

Sub ProcessFolders(ByVal objCurrentFolder As Outlook.folder)
    Dim objContacts As Items
    Dim i As Long
    Dim objContact As ContactItem
 
    Set objContacts = objCurrentFolder.Items
   
    For i = objContacts.Count To 1 Step -1
        If TypeName(objContacts(i)) = "ContactItem" Then
           Set objContact = objContacts(i)
 
           If InStr(objContact.Email1Address, strDomain) > 0 Then
              objTextFile.WriteLine (objContact.Email1Address & vbCr)
           ElseIf InStr(objContact.Email2Address, strDomain) > 0 Then
              objTextFile.WriteLine (objContact.Email2Address & vbCr)
           ElseIf InStr(objContact.Email3Address, strDomain) > 0 Then
                  objTextFile.WriteLine (objContact.Email3Address & vbCr)
           End If
        End If
    Next
 
    If objCurrentFolder.Folders.Count > 0 Then
       For Each objSubFolder In objCurrentFolder.Folders
           Call ProcessFolders(objSubFolder)
       Next
    End If
End Sub

3. Next, put the cursor into the first subroutine.
4. Finally, click the “Run” icon in the toolbar or press “F5” key button.
5. After that, in the popup dialog box, specify the domain and click “OK”.
6. When macro finishes, a text file will display, in which there are all contacts’ email addresses in the specific domain, as shown in the following figure.

Handle Disconcerting Outlook Issues

It’s very common to encounter Outlook troubles, like occasional error messages, annoying Outlook not responding, and terrible Outlook data corruption, etc. So, it is necessary for you to keep a top-ranking and well-proven relevant fix tool, such as DataNumen Outlook Repair. It is able to assist you when Scanpst, the inbox fix tool, is unable to repair Outlook problems.

Author Introduction:

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