Hello friends,
I have very well working code to add contact from Excel worksheet to Outlook, however I am facing problem - want to update the contact if already exists (for instance contact which has same emailadress as the one i have in my excel worksheet).
Will somebody help me how to modificate my code tnot only to add new contact but also to update the contact if already exist.
Thank you in advance!
Here is my code:
Sub Add_contact_tutlook()
Dim applOutlook As Outlook.Application
Dim nsOutlook As Outlook.Namespace
Dim ciOutlook As Outlook.ContactItem
Dim delFolder As Outlook.Folder
Dim delItems As Outlook.Items
Dim lLastRow As Long, i As Long, n As Long, c As Long
Set applOutlook = New Outlook.Application
Set nsOutlook = applOutlook.GetNamespace("MAPI")
Set ciOutlook = applOutlook.CreateItem(olContactItem)
ciOutlook.Display
With ciOutlook
.FirstName = Sheets("Sheet1").Cells(72, 16)
.LastName = Sheets("Sheet1").Cells(72, 20)
.Email1Address = Sheets("Sheet1").Cells(78, 16)
.MobileTelephoneNumber = Sheets("Sheet1").Cells(76, 16)
.Birthday = Sheets("Sheet1").Cells(24, 13)
End With
ciOutlook.Close olSave
Set applOutlook = Nothing
Set nsOutlook = Nothing
Set ciOutlook = Nothing
Set delFolder = Nothing
Set delItems = Nothing
End Sub
I have very well working code to add contact from Excel worksheet to Outlook, however I am facing problem - want to update the contact if already exists (for instance contact which has same emailadress as the one i have in my excel worksheet).
Will somebody help me how to modificate my code tnot only to add new contact but also to update the contact if already exist.
Thank you in advance!
Here is my code:
Sub Add_contact_tutlook()
Dim applOutlook As Outlook.Application
Dim nsOutlook As Outlook.Namespace
Dim ciOutlook As Outlook.ContactItem
Dim delFolder As Outlook.Folder
Dim delItems As Outlook.Items
Dim lLastRow As Long, i As Long, n As Long, c As Long
Set applOutlook = New Outlook.Application
Set nsOutlook = applOutlook.GetNamespace("MAPI")
Set ciOutlook = applOutlook.CreateItem(olContactItem)
ciOutlook.Display
With ciOutlook
.FirstName = Sheets("Sheet1").Cells(72, 16)
.LastName = Sheets("Sheet1").Cells(72, 20)
.Email1Address = Sheets("Sheet1").Cells(78, 16)
.MobileTelephoneNumber = Sheets("Sheet1").Cells(76, 16)
.Birthday = Sheets("Sheet1").Cells(24, 13)
End With
ciOutlook.Close olSave
Set applOutlook = Nothing
Set nsOutlook = Nothing
Set ciOutlook = Nothing
Set delFolder = Nothing
Set delItems = Nothing
End Sub