Create Outlook Contact Error 13

G

Guest

I have had difficulty getting this to work. Can anybody tell me what I have
done wrong? I want to create a contact from excel and have it saved to
Outlook Public Folders.

Sub CreateOutlookContact()
'called from onsheet btn
'early binding to Microsoft Outlook 12.0 Object library (Outlook 2007)

Dim olApp As Outlook.Application
Dim olCi As Outlook.ContactItem
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim iAnswer As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.Folders("Public Folders").Folders("All Public
Folders").Folders("The Solar Company").Folders("TSC-Contacts")

For Each olCi In Fldr.Items
If olCi.FirstName = [PrimaryFirst] And olCi.LastName = [PrimaryLast]
Then
iAnswer = MsgBox("A contact with that first and last name
already exists." & vbCrLf & vbCrLf & "Click Ok to overwrite it.", vbOKCancel)
If iAnswer = vbOK Then
olCi.Delete
Else
Exit Sub
End If
End If
Next olCi

Set olCi = olApp.CreateItem(olContactItem)

With olCi
.FirstName = [PrimaryFirst]
.LastName = [PrimaryLast]
.HomeTelephoneNumber = [PrimaryHomePhone]
.BusinessFaxNumber = [PrimaryFax]
.MobileTelephoneNumber = [PrimaryMobile]
.BusinessTelephoneNumber = [PrimaryBusinessPhone]
.Email1Address = [PrimaryEmail]
.Body = "Second Owner Information:" & vbCrLf & _
"First Name: " & [SecondaryFirst] & vbCrLf & _
"Last Name: " & IIf([SecondaryLast] = "", [PrimaryLast],
[SecondaryLast]) & vbCrLf & _
"Phone Number: " & [SecondaryPhone] & vbCrLf & _
"APN: " & [APN]
.Business2TelephoneNumber = [SecondaryPhone]
.MailingAddressStreet = [MailingStreet]
.MailingAddressCity = [MailingCity]
.MailingAddressPostalCode = [MailingZip]
.OtherAddressStreet = [JobStreet]
.OtherAddressCity = [JobCity]
.OtherAddressPostalCode = [JobZip]

.Categories = [OutlookCat]

.Save

iAnswer = MsgBox([PrimaryFirst] & " " & [PrimaryLast] & " has been
added to your Outlook Contacts." & vbCrLf & vbCrLf & "Do you want to display
the contact now?", vbYesNo)
If iAnswer = vbYes Then
.Display
End If
End With

Set olCi = Nothing
Set olApp = Nothing

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top