Create Outlook contacts in bulk using VBA automation
January 12, 2009 • JP • 14 Comments • Rate This Article
A visitors writes and asks "Do you have any code to read an Excel sheet and update Outlook contacts?"
So I whipped up the following code, and thought I would share it with anyone else who needs to create Outlook contacts in bulk, possibly as part of a larger application, filling in the most popular fields (name, email, company).
(FYI — the code at Export Outlook Contacts to Excel does the reverse.)
First I created a sample worksheet with some dummy information, courtesy of Fake Name Generator.
The columns have to be filled out as follows:
- Column A: First Name
- Column B: Last Name
- Column C: Email Address
- Column D: Company Name
- Column E: Business Telephone
- Column F: Business Fax
- Column G: Home Phone
Row 1 must contain headers. The code assigns the entire block of contact information to an array, then creates a contact from each one. As usual, the function returns a boolean value of TRUE if successful.
Function CreateContactsFromList() As Boolean
' creates contacts in bulk from Excel worksheet
' Col A: First Name
' Col B: Last Name
' Col C: Email Address
' Col D: Company Name
' Col E: Business Telephone
' Col F: Business Fax
' Col G: Home Phone
' Row 1 should be a header row
On Error GoTo ErrorHandler
Dim lNumRows As Long
Dim lNumCols As Long
Dim lCount As Long
Dim varContactInfo As Variant
Dim olContact As Object ' Outlook.ContactItem
Dim strCurrentFirstName As String
Dim strCurrentLastName As String
Dim strCurrentEmailAddr As String
Dim strCurrentCompany As String
Dim strCurrentBusinessPhone As String
Dim strCurrentBusinessFax As String
Dim strCurrentHomePhone As String
' figure out how big our array needs to be, and size appropriately
lNumRows = Sheet1.Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)).Count
lNumCols = Sheet1.Range(Range("A1"), Range("IV1").End(xlToLeft)).Count
ReDim varContactInfo(1 To lNumRows, 1 To lNumCols)
varContactInfo = Range(Cells(2, 1), Cells(lNumRows + 1, lNumCols))
' get Outlook
Dim olApp As Object ' Outlook.Application
Set olApp = GetOutlookApp
lCount = 1
Do Until lCount = lNumRows
' assign variant values to intermediate string varbs
strCurrentFirstName = varContactInfo(lCount, 1)
strCurrentLastName = varContactInfo(lCount, 2)
strCurrentEmailAddr = varContactInfo(lCount, 3)
strCurrentCompany = varContactInfo(lCount, 4)
strCurrentBusinessPhone = varContactInfo(lCount, 5)
strCurrentBusinessFax = varContactInfo(lCount, 6)
strCurrentHomePhone = varContactInfo(lCount, 7)
' CreateItem will create a contact in the default folder
Set olContact = olApp.CreateItem(2) ' olContactItem
With olContact
.FirstName = strCurrentFirstName
.LastName = strCurrentLastName
.Email1Address = strCurrentEmailAddr
.CompanyName = strCurrentCompany
.BusinessTelephoneNumber = strCurrentBusinessPhone
.BusinessFaxNumber = strCurrentBusinessFax
.HomeTelephoneNumber = strCurrentHomePhone
End With
olContact.Close 0 ' olSave
lCount = lCount + 1
Loop
' if we got this far, assume success
CreateContactsFromList = True
GoTo ExitProc
ErrorHandler:
CreateContactsFromList = False
ExitProc:
Set olContact = Nothing
If bWeStartedOutlook Then
olApp.Quit
End If
Set olApp = Nothing
End Function
Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject("Outlook.Application")
bWeStartedOutlook = True
End If
On Error GoTo 0
End Function
Sample usage:
Dim success As Boolean
success = CreateContactsFromList
End Sub
And I've uploaded the workbook containing the code and the sample data for you to test out, but don't press F5 or you'll end up with 100 useless new contacts 
Automation, Excel ·
Rate This Article:
(No Ratings Yet)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: Create Distribution Lists for your Contacts
Next Post: Excel Tutorial Series – some simple functions
Hi and Thanks for the code…
In or following the line,
Set olContact = olApp.CreateItem(2) ' olContactItem
How would I save the contact to a designate Contacts Subfolder.
I have allowed the choice of folder using;
Set olFolder = olNs.PickFolder
But don't know the code to set the save folder to olFolder
Thanks for your time
~Mike~
Once you have the olFolder reference, olFolder.Items.Add will return a reference to a new ContactItem in that folder. It would be something like
Set olContact = olFolder.Items.Add
Hi JP,
Perfect, Just what I was looking for
Thanks very Much
~Mike~
I wrote something similar in Perl about 7 years ago and this was so much easier. I tweaked the fields a little bit and was able to load 180 contacts in 5 seconds. Thanks!
Is is possible to have Outlook check for possible matches before it saves the contacts?
Thanks in Advance
Before creating the item, try and assign olContact to an existing contact in the default Contacts folder with the same name. If it doesn't exist, then go ahead and create it. Put this code right before "Set olContact = olApp.CreateItem(2)":
On Error Resume Next
Set olContact = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items.Item(strCurrentFirstName & " " & strCurrentLastName)
If Not olContact Is Nothing Then
And you'll have to close the loop right after "olContact.Close olSave".
Thanks for the code. I tried to use the sample as is to test after deleting all but 10 rows. I got a compiler error on this line: olSave
olContact.Close olSave
I also wanted to know if it could be used to put contacts into different categories?
Thanks for your help.
Bob
My mistake, olSave is an Outlook constant, and since we're using late-bound code, we can't use constants. We have to use their numerical equivalents (instead of olSave, use '0'). I'll update the code in the post.
As far as categories, ContactItem has a Categories property which you can read/write. See Categories Property for sample code.
Hey JP,
Thanks for the fix and prompt reply that works perfectly. I am new to VBA and I think the sub-folder code you gave above will do what I want to do.
The problem is I can't get the sub-folder code to run. I get an error on:
olNs
I want to add a sub-folder named "New1" to contacts can you steer me in the right direction of what the 2 lines of code would look like.
Set olFolder = olNs.PickFolder
Set olContact = olFolder.Items.Add
Thanks again,
Bob R
The code would be a bit different. To create a subfolder one level below the default Contacts, check out the CheckForFolder and CreateSubFolder procedures in Look for and create folders programmatically in Outlook. The procedures will have to be modified, however, since you want a Contacts folder, not a Mail Items folder.
In both procedures, change
to
The general syntax to call both functions would be
If CheckForFolder("New1") = False Then ' Folder doesn't exist
Set MyFolder = CreateSubFolder("New1")
End If
Hi brother,
I am very new to VB. This is the code I was looking for.
I have download the sample file, but I dont know how to run this sample doc.
Can you please help me/
Your help would greatly be appreciated.
Press Alt+F8 and run the macro named "test". Warning: you'll end up with 100 fake new contacts.
Thank you so much for the reply,
One last request. Do you have script for editing the contacts in outlook?
I would be very grateful to you.
Regards,
I have a like minded query. Here in a corp environment we're using exchange. It seems depending on WHEN you saved a contact in your address book sometimes the contacts object has some changes after apparent upgrades. I've written scripts that fail if the contact is older than a newer saved version from Exchange?
Is there a way to mass update all the contacts that are on the exchange server to ensure you have to the latest info? This would be great.