E
Eric
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
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