Script to import contacts from Excel to Outlook

I have an excel spreedsheet with contacts in an .xls format.  
I need to know how to import that into a users Outlook Contacts folder.

The excel sheet has 4 sheets.  I need the data from the sheet called "Full Compliance List" imported.

The 2 fields at Name and Email address (attached)

It should not import duplicates.
LVL 10
abraham808Asked:
Who is Participating?
 
David LeeCommented:
Hi, abraham808.

The code below will do what you describe.  Follow these instructions to use this script:

1.  Open Notepad
2.  Copy the script and paste it into Notepad
3.  Edit the script per the comments I included in it
4.  Save the file with a .vbs extension
5.  Run the script by double-clicking on the .vbs file
Const olFolderContacts = 10
Const olContactItem = 2
Dim excApp, excWkb, excWks, olkApp, olkSes, olkFld, olkCon, lngRow
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
'Change the profile name on the next line as needed'
olkSes.Logon "Outlook"
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts)
Set excApp = CreateObject("Excel.Application")
'Change the file name and path on the next line'
Set excWkb = excApp.Workbooks.Open("C:\eeTesting\excel-compliance.xls")
For Each excWks In excWkb.Sheets
    lngRow = 2
    Do Until excWks.Cells(lngRow, "A") = ""
        Set olkCon = olkFld.Items.Find("[FullName] = '" & excWks.Cells(lngRow, 2) & "'")
        If TypeName(olkCon) = "Nothing" Then
            Set olkCon = Application.CreateItem(olContactItem)
            With olkCon
                .FullName = excWks.Cells(lngRow, "B")
                .Email1Address = excWks.Cells(lngRow, "C")
                .Save
            End With
        End If
        lngRow = lngRow + 1
    Loop
Next
Set olkCon = Nothing
Set olkFld = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
Set excWks = Nothing
excWkb.Close False
Set excWkb = Nothing
excApp.Quit
Set excApp = Nothing
msgbox "Import complete.", vbInformation + vbOKOnly, "Import Contacts"

Open in new window

0
 
abraham808Author Commented:
Forgot to add spreadsheet example.
excel-compliance.xls
0
 
Richard DanekeTrainerCommented:
In outlook, there is a File, Import option.  
It is best to work with only one worksheet, so copy the worksheet you want to import into a new workbook. (You can do this with a right click n the sheet tab, check Create Copy!)
Hopefully, you have a list with column headings.  Outlook will let you map fields and choose to ignore duplicates.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
ashishkpandeyCommented:
Use import / export wizard. While importng select CSV and you can have your excel contacts into outlook contacts.
0
 
abraham808Author Commented:
I know how to do that.  Looking for a script.
0
 
yehudahaCommented:
a liitle error

change line 17 to :

Set olkCon = olkApp.CreateItem(olContactItem)
0
 
David LeeCommented:
Good catch, yehudaha.  Thanks!
0
 
yehudahaCommented:
By the way

nice job BlueDevilFan
0
 
David LeeCommented:
That's very kind of you.  Thanks!
0
 
abraham808Author Commented:
This script works perfectly but what if i wanted the contacts to go into a SUB contacts folder called Compliance?
0
 
David LeeCommented:
Change line #8 from

    Set olkFld = olkSes.GetDefaultFolder(olFolderContacts)

to

    Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders("Compliance")
0
 
abraham808Author Commented:
Absolutely perfect.  
0
 
abraham808Author Commented:
i spoke too soon ...the main Contacts got populated again not the subfolder. Also there was duplicate entries.  Any way to stop the duplication and get it into the sub folder?
0
 
abraham808Author Commented:
hi not sure if you got the last comment.

The sub contacts folder did not get populated.
The main Contacts folder did and it also created duplicates.

Is there a way not to duplicate and get it into the subfolder?
0
 
GTVRCommented:
Hello,

sorry to revive an old thread, but this has worked perfectly for me.

But was wondering how to make a few amendments.

1: if it is possible to delete duplicates how would I do that, if it is not possible that would be fine.

2: How could I incorporate some other fields, such as what the display name is, as currently it uses the name and email address. also would like to add the persons extension and their direct contact number in the office as well as their mobile number.

3: Is there a way to create Groups using this method?

Many thanks in advance for your assistance.

regards
0
 
David LeeCommented:
Hi, GTVR.

1.  Yes, it's possible to delete duplicates.  What test do you want to use to determine if the contact is a duplicate (e.g. match on the name, name and email address, name and phone number)?

2.  You can add additional fields by adding additional lines like lines 19 and 20.  The format of the command is FIELDNAME = SOME VALUE.  Tell me which fields and you want to add and where to get the values from and I can modify the code for you.

3.  What do you mean by "groups"?
0
 
GTVRCommented:
Hi BlueDevilFan,

Thanks for the reply.

1. If it could compare against the email address, I think that would be the best option.

2. I have attached an example contact list.

3. I mean outlook distribution list, the issue I have encountered is if I export my contact list to a .csv, .xlsx or .txt the groups are never exported, my understanding is they are a collection of contacts from within outlook and are therefore not real email address. As a solution I have created them a real distribution list on a email client and manage them through there. So it is not vital to find a solution to this now, I think it's more just curiosity now.

Regards
examplecontactlist.xlsx
0
 
David LeeCommented:
You're welcome.

1.  Ok.

2.  I looked at the sample.  Is FullName supposed to appear twice?  Also, Outlook contacts don't have fields named "Ext", "DirectLine" or "Position".  For "Position" I've used "JobTitle" which is the closest contact field to "Position".  For "DirectLine" do you want to use "BusinessTelephoneNumber"?  I assume that "Ext" refers to a telephone extension.  If so, then Outlook stores the extension as part of the actual telephone number, so what number should extension be tacked on to?

3.  A distribution isn't exactly a collection of contacts.  By that I mean that Outlook doesn't store all the contact information for each member of the DL in the DL.  It stores a subset of the information.  If you want the ability to add imported contacts to a DL, then I could add code for doing that.  You'd need to include a column that would store the name of the DL the contact is to be added to.  The code would check to see if that DL exists and, if so, add the contact to it.  If the DL doesn't exist, then the code could create it and then add the contact.
0
 
GTVRCommented:
Hello,

1. Cheers

2. I have used the Fullname twice to populate the FullName field and the File AS field, otherwise it files it as Name & email address which looks quite cluttered in the contacts section. I have attached a screen shot.
If I export a contact list with all of outlook fields, I get 92 different columns. Am I amble to use these columns to populate data? if so the if you look at my attachment on sheet 1 is the data that I would like & and sheet 2 are the columns from outlook. If I need then in the BuisnessTelephoneNumber field I can just put someones direct line then in brackets I could add their extension.

3. I have added two columns at the end, is this correct?

Kind regards,
examplecontactlist.xlsx
Contact..jpg
0
 
David LeeCommented:
2.  You don't need to include Fullname twice.  The code can use it to populate both the FullName and FileAs without the value appearing twice in the spreadsheet.  Yes, you can use any of the exported fields or any other data for that matter to populate fields on the import.  That brings up a question though.  Are you planning to export contacts and then use this code to import them?  If that's the plan, then why?  Outlook has a built-in import that will do all the work for you without the need for any code.  

3.  All you really need is the DistributionList column populated with the name or a comma separated list of names of a distribution list/lists you want to add the contact to.  Of course this assumes that I've understood correctly what you want.  My understanding is that you want to add each contact to one or more distribution lists.  I'm not assuming that you exported distribution lists and are trying to re-import them.

Forgetting the technical details, what's your usage scenario?
0
 
GTVRCommented:
2. The exporting I did was to get the column headers. We used to get the users to do the manual import of new contact lists, however some people struggled with the instructions and due to the fact that our contact lists change very regularly I would like to make the process a lot simpler.

3. If that's all that is needed that is great.

Currently with the first script I have sent our staff an email they tells them to delete their contacts and then within the email there is an image which they click, it asks if they would like to run the script and the it imports the contact list. Previously we had to send them a step by step instruction on how to manually import the .pst file.
0
 
David LeeCommented:
So you want to use this to send out contacts, lists, or both?
0
 
GTVRCommented:
Both Please.
0
 
David LeeCommented:
GTVR,

I think this will do it.  It works with the spreadsheet you uploaded.  Please give it a try.

'On the next line edit the file name and path as needed
Const WKB_PATH = "C:\Users\David\Downloads\examplecontactlist.xlsx"
Const SCRIPT_NAME = "Import Contacts"
Const olFolderContacts = 10
Const olContactItem = 2
Const olDistributionListItem = 7


Dim excApp, excWkb, excWks, olkApp, olkSes, olkFld, olkCon, olkLst, olkRcp, lngRow, arrMbr, varMbr

'Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName

'Get the target folder
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts)

'Connect to Excel
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Open(WKB_PATH)

'Main routine
For Each excWks In excWkb.Sheets
    lngRow = 2
    For lngRow = 2 to excWks.UsedRange.Rows.Count
        If excWks.Cells(lngRow, "A") = "" then
            'Create a distribution list
            Set olkLst = olkApp.CreateItem(olDistributionListItem)
            olkLst.Subject = excWks.cells(lngRow, "H")
            arrMbr = Split(excWks.Cells(lngRow, "I"), ";")
            For Each varMbr in arrMbr
                Set olkRcp = olkSes.CreateRecipient(varMbr)
                olkRcp.Resolve
                olkLst.AddMember olkRcp
            Next
            olkLst.Save
            Set olkLst = Nothing
            Set olkRcp = Nothing
        Else
            'Create a contact
            Set olkCon = olkFld.Items.Find("[Email1Address] = '" & excWks.Cells(lngRow, "C") & "'")
            If TypeName(olkCon) = "Nothing" Then
                Set olkCon = olkApp.CreateItem(olContactItem)
                With olkCon
                    .FullName = excWks.Cells(lngRow, "A")
                    .Email1Address = excWks.Cells(lngRow, "C")
                    .JobTitle = excWks.Cells(lngRow, "D")
                    .CompanyMainTelephoneNumber = excWks.Cells(lngRow, "E")
                    .Business2TelephoneNumber = excWks.Cells(lngRow, "F")
                    .MobileTelephoneNumber = excWks.Cells(lngRow, "G")
                    .Save
                End With
            End If
        End IF
    Next
Next

'Clean-up objects to avoid memory leaks
Set olkCon = Nothing
Set olkFld = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
Set excWks = Nothing
excWkb.Close False
Set excWkb = Nothing
excApp.Quit
Set excApp = Nothing

'Let the user know that processing is complete
Msgbox "Import complete.", vbInformation + vbOKOnly, SCRIPT_NAME

Open in new window

0
 
GTVRCommented:
Hello,

this is fantastic, the only issue i have encountered is that if I remove a contact off the spreadsheet and try re-import the list with the script it does not remove those contacts.

regards
0
 
David LeeCommented:
No, it's not designed to do that.  It only adds items.  No deletes or updates.  Adding the ability to update a contact would be easy.  Deletes aren't, unless you want to simply wipe out all the contacts first and then import what's in the spreadsheet.  In other words, a complete replacement each time the script is run.  The problem with a delete is that Outlook has no idea that an entry was in the sheet the last time the script was run but isn't now.  For something like that to work the process would have to keep tabs on what was in the spreadsheet the last time in order to compare it to what's in the sheet this time.
0
 
GTVRCommented:
Ok that makes sense, could we do it that it deletes the all the contacts each time the script is run?
0
 
David LeeCommented:
This version will delete all existing contacts at the start of the run.  Note that it does not delete distribution lists.

'On the next line edit the file name and path as needed
Const WKB_PATH = "C:\Users\David\Downloads\examplecontactlist.xlsx"
Const SCRIPT_NAME = "Import Contacts"
Const olFolderContacts = 10
Const olContact = 40
Const olContactItem = 2
Const olDistributionListItem = 7


Dim excApp, excWkb, excWks, olkApp, olkSes, olkFld, olkCon, olkLst, olkRcp, lngRow, arrMbr, varMbr

'Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName

'Get the target folder
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts)

'Connect to Excel
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Open(WKB_PATH)

'Delete all existing contacts
For lngRow = olkFld.Items.Count To 1 Step -1
    Set olkCon = olkFld.Items.Item(lngRow)
    If olkCon.Class = olContact Then
        olkCon.Delete
    End If
Next

'Main routine
For Each excWks In excWkb.Sheets
    lngRow = 2
    For lngRow = 2 To excWks.UsedRange.Rows.Count
        If excWks.Cells(lngRow, "A") = "" Then
            'Create a distribution list
            Set olkLst = olkApp.CreateItem(olDistributionListItem)
            olkLst.Subject = excWks.Cells(lngRow, "H")
            arrMbr = Split(excWks.Cells(lngRow, "I"), ";")
            For Each varMbr In arrMbr
                Set olkRcp = olkSes.CreateRecipient(varMbr)
                olkRcp.Resolve
                olkLst.AddMember olkRcp
            Next
            olkLst.Save
            Set olkLst = Nothing
            Set olkRcp = Nothing
        Else
            'Create a contact
            Set olkCon = olkFld.Items.Find("[Email1Address] = '" & excWks.Cells(lngRow, "C") & "'")
            If TypeName(olkCon) = "Nothing" Then
                Set olkCon = olkApp.CreateItem(olContactItem)
                With olkCon
                    .FullName = excWks.Cells(lngRow, "A")
                    .Email1Address = excWks.Cells(lngRow, "C")
                    .JobTitle = excWks.Cells(lngRow, "D")
                    .CompanyMainTelephoneNumber = excWks.Cells(lngRow, "E")
                    .Business2TelephoneNumber = excWks.Cells(lngRow, "F")
                    .MobileTelephoneNumber = excWks.Cells(lngRow, "G")
                    .Save
                End With
            End If
        End If
    Next
Next

'Clean-up objects to avoid memory leaks
Set olkCon = Nothing
Set olkFld = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
Set excWks = Nothing
excWkb.Close False
Set excWkb = Nothing
excApp.Quit
Set excApp = Nothing

'Let the user know that processing is complete
MsgBox "Import complete.", vbInformation + vbOKOnly, SCRIPT_NAME
 

Open in new window

0
 
GTVRCommented:
Excellent, Thank you so Much.

regards
0
 
David LeeCommented:
You're welcome!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.