Select a name in a Word document then create a Contact

This Word VBA code sample can be used with résumés and other documents to create a new contact containing the document body in the notes field. If the address, phone number, or other fields are well-defined in your documents, you can use regex to grab data from other fields.

For addins and utilities that can capture address data and create contacts, see Message Extraction Tools. Many of the utilities offer more features than you can get with a simple macro.

Paste this code into Word's VBA Editor (NOT Outlook's VBA Editor). Don't forget to set a reference to Outlook Object Library and VBScript 5.5 in Tools, References.

You need to select the person's name in the document before running the macro.

Note: the document is searched for the first email address matching the pattern. I think it will capture every address (and twitter handle); if you have a better pattern that works, let me know. To get the last address in the document (such as from the footer, add .Global = True after .IgnoreCase = True.

Sub AddOutlookContacts()

 Dim olObj As Object
 Dim oContact As Outlook.ContactItem
 
 Dim strFullName As String
 Dim strEmail As String
 
 Dim iSplit As Long
 Dim iResult As Long
 
 strFullName = Selection.Range
 
 ' Check to see if name is selected
 If Len(strFullName) < 1 Then
 MsgBox "No name selected!" & vbCr & "Select the full name and re-run the macro", vbCritical, "Select Full Name"
 Exit Sub
 End If
 
 ' Verify the selected name is correct
 iResult = MsgBox("Is the full name correct?" & _
 vbCr & vbCr & strFullName, vbYesNo, "Address")
 
 If iResult = 7 Then GoTo UserCancelled:
 
' Find the first @ and get the text around it for the email address
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
              
    Set Reg1 = New RegExp
    With Reg1
        .Pattern = "(([\w-\.]*\@[\w-\.]*)\s*)"
        .IgnoreCase = True
    End With
    If Reg1.test(ActiveDocument.Content) Then
     
        Set M1 = Reg1.Execute(ActiveDocument.Content)
        For Each M In M1
           strEmail = M.SubMatches(1)
        Next
    End If

' create contact and put it together
Set olObj = CreateObject("Outlook.Application")
Set oContact = olObj.CreateItem(olContactItem)
With oContact
    .Email1Address = strEmail
    .FullName = strFullName
    .Body = ActiveDocument.Content
    .Categories = "resume"
   .Save
End With
oContact.Display
  
 
 Set olObj = Nothing
 Exit Sub

UserCancelled:
 MsgBox "User Cancelled or address not selected"
 Set olObj = Nothing
 
 End Sub

How to use macros

First: You will need macro security set to low during testing.

To check your macro security, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In older version of Office, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the code in a module:

1. Right click on Normaland choose Insert > Module
2. Copy and paste the macro into the new module.

More information as well as screenshots are at How to use the VBA Editor