Import contacts form excel to Outlook by vba

[Wojbara]

Hi,
I know that similar post has be already created time ago but I tried base on them and still couldn't import contacts from excel to Outlook (file csv of course).
Maybe form begin I have a list of contacts with should import to Outlook (MS Office 2013) it should be updated existing folder (specific) and replace all contacts (duplicated should be deleted).
I base on below code but it dosen't work:

Sub ExcelWorksheetDataAddToOutlookContacts3()
'Automating Outlook from Excel: This example uses the Items.Add Method to export data from an Excel Worksheet to the default Contacts folder.
'Automate Outlook from Excel, using Late Binding. You need not add a reference to the Outlook library in Excel (your host application), in this case you will not be able to use the Outlook's predefined constants and will need to replace them by their numerical values in your code.​

'Ensure that the worksheet data to be posted to Outlook, starts from row number 2:

'Ensure corresponding columns of data in the Worksheet, as they will be posted in the Outlook Contacts Folder:
'Column A: First Name
'Column B: Last Name
'Column C: Email Address
'Column D: Company Name
'Column E: Mobile Telephone Number

Dim oApplOutlook As Object
Dim oNsOutlook As Object
Dim oCFolder As Object
Dim oDelFolder As Object
Dim oCItem As Object
Dim oDelItems As Object
Dim lLastRow As Long, i As Long, n As Long, c As Long

'determine last data row in the worksheet:
lLastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

'Create a new instance of the Outlook application, if an existing Outlook object is not available.
'Set the Application object as follows:
On Error Resume Next
Set oApplOutlook = GetObject(, "Outlook.Application")
'if an instance of an existing Outlook object is not available, an error will occur (Err.Number = 0 means no error):
If Err.Number <> 0 Then​

Set oApplOutlook = CreateObject("Outlook.Application")​

End If
'disable error handling:
On Error GoTo 0

'use the GetNameSpace method to instantiate (ie. create an instance) a NameSpace object variable, to access existing Outlook items. Set the NameSpace object as follows:
Set oNsOutlook = oApplOutlook.GetNamespace("MAPI")

'----------------------------​

'Empty the Deleted Items folder in Outlook so that when you quit the Outlook application you bypass the prompt: Are you sure you want to permanently delete all the items and subfolders in the "Deleted Items" folder?

'set the default Deleted Items folder:
'The numerical value of olFolderDeletedItems is 3. The following code has replaced the Outlook's built-in constant olFolderDeletedItems by its numerical value 3.
Set oDelFolder = oNsOutlook.GetDefaultFolder(3)
'set the items collection:
Set oDelItems = oDelFolder.Items

'determine number of items in the collection:
c = oDelItems.Count
'start deleting from the last item:
For n = c To 1 Step -1​

oDelItems.Delete​

Next n​

'----------------------------

'set reference to the default Contact Items folder:
'The numerical value of olFolderContacts is 10. The following code has replaced the Outlook's built-in constant olFolderContacts by its numerical value 10.
Set oCFolder = oNsOutlook.GetDefaultFolder(10)

'post each row's data on a separate contact item form:
For i = 2 To lLastRow​

'Using the Items.Add Method to create a new Outlook contact item in the default Contacts folder.
Set oCItem = oCFolder.Items.Add
'display the new contact item form:
oCItem.Display
'set properties of the new contact item:
With oCItem​

.firstName = Sheets("Sheet1").Cells(i, 1)
.LastName = Sheets("Sheet1").Cells(i, 2)
.Email1Address = Sheets("Sheet1").Cells(i, 3)
.CompanyName = Sheets("Sheet1").Cells(i, 4)
.MobileTelephoneNumber = Sheets("Sheet1").Cells(i, 5)​

End With
'close the new contact item form after saving:
'The numerical value of olSave is 0. The following code has replaced the Outlook's built-in constant olSave by its numerical value 0.
oCItem.Close 0​

Next i

'quit the Oulook application:
oApplOutlook.Quit

'clear the variables:
Set oApplOutlook = Nothing
Set oNsOutlook = Nothing
Set oCFolder = Nothing
Set oDelFolder = Nothing
Set oCItem = Nothing
Set oDelItems = Nothing

MsgBox "Successfully Exported Worksheet Data to the Default Outlook Contacts Folder."​

​

End Sub

Can anyone help me please?

Thanks
​

 

[Wojbara]

Hi

Me again code now works but still I can't replace duplicate if I run macro still I will be have few the same contacts, can anyone know how remove dupilcate by vba in outlook?

 

[redzer]

Hi, could you share the code that you got to work?

Thanks

 

[sammv]

I would like to do same thing but not import contact info but some other info from excel to a specific folder (not contact folder) but a different folder in outlook. Can I do that? and if so how can I tweak the above code to use it or is there new code I need for this? Please share the code for this. Thanks in advance