How to Quickly Create Outlook Contacts for All Email Addresses Occurring in a Word Document

This article will share you a method to quickly extract all the email addresses from a Word document and then create according contacts for them in your Outlook.

In my previous article – “How to Quickly Send an Outlook Email to All Email Addresses Occurring in Several Word documents”, you can easily learn to send an email to the email addresses in Word documents. Similarly, maybe for the future convenience, you may wish to create the corresponding contacts for these email addresses. Here we will guide you how to realize it in quick time.

Create Outlook Contacts for All Email Addresses Occurring in a Word Document

Create Contacts for All Email Addresses Occurring in a Word document

  1. To start with, launch your Outlook program.
  2. Then in the main Outlook screen, you can press “Alt + F11” key buttons.
  3. Next you’ll get access to Outlook VBA editor window, in which you ought to open a module that is not in use.
  4. Subsequently, you need to copy the following VBA code into this module.
Sub AddEmailAddresses_OutlookContacts()
    Dim objWordApp As Word.Application
    Dim objWordDocument As Word.Document
    Dim strEmailAddress, strFullName As String
    Dim objContacts As Outlook.Items
    Dim i As Long
    Dim strFilter As String
    Dim objFoundContact As Outlook.ContactItem
    Dim objNewContact As Outlook.ContactItem
    Set objWordApp = CreateObject("Word.Application")
    objWordApp.Visible = True
    'Change the path to the source Word document
    Set objWordDocument = objWordApp.Documents.Open("E:\Outlook\DataNumen Outlook Repair.docx")
    'Find the email addresses via wildcards
    With objWordApp.Selection.Find
         .Text = "[A-z,0-9]{1,}\@[A-z,0-9,.]{1,}"
         .MatchWildcards = True
    End With
    While objWordApp.Selection.Find.Found
          'Get the email address
          strEmailAddress = objWordApp.Selection.Text
          'Get the name from the email address
          strFullName = Split(strEmailAddress, "@")(0)
          Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts).Items
          'Check if the email address has been in your Contacts folder
          For i = 1 To 3
              strFilter = "[Email" & i & "Address] = " & strEmailAddress
              Set objFoundContact = objContacts.Find(strFilter)
              If Not objFoundContact Is Nothing Then
                 Exit For
              End If
          Next i
          'If email addresses are not in the default Contacts folder
          If objFoundContact Is Nothing Then
             'Create a new Outlook Contact
             Set objNewContact = Application.CreateItem(olContactItem)
             'Input the contact email address and full name
             With objNewContact
                  .Email1Address = strEmailAddress
                  .FullName = strFullName
                  '.Save ==> Save the contact
             End With
          End If
    'Close the Word document
    'Exit Word Application
End Sub

VBA Code - Quickly Create Outlook Contacts for All Email Addresses Occurring in a Word Document

  1. After that, you have to ensure that macros are enabled in your Outlook in the “Macro Settings”.
  2. Eventually, you can have a try. In the new macro window, press F5 key button to run this macro.
  3. Then, Outlook will automatically create the contacts for the email addresses which haven’t existed in your default Contacts folder.

Keep a Formidable Fix Tool Nearby

Though Outlook is loaded with quantities of functions, it is still vulnerable to lots of factors, such as human improper operations, virus infections and so on. Hence, aside from making regular backups and relying on inbox repair tool, you’d better also keep another remarkable and reliable PST fix tool nearby, like DataNumen Outlook Repair. It can scan and restore Outlook data with utmost ease.

Author Introduction:

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

Leave a Reply

Your email address will not be published. Required fields are marked *