Update Contacts with a New Company Name and Email Address

It can be a real hassle to update contacts when a company changes their name and domain. While it's actually really easy to change the company name by using group by company view and dragging contacts to a new group, you can't change the email address field using this method.

This version of my super-duper bulk contact code updates the Company name and email domain on contacts. As written, it assumes all contacts from that company use the same exact company name and the new addresses will keep the same alias (part before the @).

The macro copies the original company name and email address to the user3 and user4 fields. If you are using those fields for other data, you'll need to delete those lines.

Public Sub ChangeCompany()

    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objContact As Outlook.ContactItem
    Dim objItems As Outlook.Items
    Dim objContactsFolder As Outlook.MAPIFolder
    Dim obj As Object
    Dim strAlias As String

    On Error Resume Next

    Set objOL = CreateObject("Outlook.Application")
    Set objNS = objOL.GetNamespace("MAPI")
    Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
    Set objItems = objContactsFolder.Items

    For Each obj In objItems
        'Test for contact and not distribution list
        If obj.Class = olContact Then
            Set objContact = obj
            
            If objContact.CompanyName = "Old Company" Then
            
         strAlias = Left(objContact.Email1Address, InStr(objContact.Email1Address, "@") - 1)
             Debug.Print strAlias
            With objContact
' if you aren't using the user fields, save a copy of the original company and email
             .User3 = .CompanyName
             .User4 = .Email1Address

                 .CompanyName = "New Company"
                 .Email1Address = strAlias & "@newcompany.com"
                 .Save
            End With
            End If
        End If

        Err.Clear
    Next

    Set objOL = Nothing
    Set objNS = Nothing
    Set obj = Nothing
    Set objContact = Nothing
    Set objItems = Nothing
    Set objContactsFolder = Nothing
End Sub

If contacts use several variations of a company name (ie, Microsoft or Microsoft Corp), you can use this as the If statement instead, with enough of the old company name to be unique.

If InStr(LCase(objContact.CompanyName), "company") Then

If, instead, you need to change email domains, for example if an ISP changes their domain, or prefer to use the email domain to identify the contacts that need updated, use this as the If statement to check the address:

strDomain = Right(objContact.Email1Address, Len(objContact.Email1Address) - InStrRev(objContact.Email1Address, "@"))
      If strDomain = "newexample.com" Then
             strAlias = Left(objContact.Email1Address, InStrRev(objContact.Email1Address, "@") - 1)

How to use macros

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

To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, 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: