View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Eric Eric is offline
external usenet poster
 
Posts: 1,670
Default 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