Create Outlook Contact Error 13
 

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

Create Outlook Contact Error 13
 

I should have added the line with

Next olCi

Is highligted when I debug