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:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
More Information
More Bulk Change Contact articles at Slipstick.com:
