linking Outlook appointments and contacts from Excel

[savarin]

I am using VBA to create Outlook appointments and contacts. I can't seem
to figure out how to link the appointment to the contact. Please help


This is the code I am using:

Sub Register_Appointment()
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim itmContact As Outlook.ContactItem
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim tempstr As Outlook.ContactItem
Dim myItems As Outlook.Folders

Set olAppItem = olApp.CreateItem(olAppointmentItem)

' creates a new appointment

Set itmContact = olApp.CreateItem(olContactItem)
Set myNameSpace = olApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts)

With olAppItem
..Start = Now
..End = Now
..Subject = "No subject"
..Location = ""
..Body = ""
..Companies = ""
..ReminderSet = True
..Companies = ""

' read appointment values from the worksheet

On Error Resume Next
..Start = Cells(12, 2).Value + Cells(13, 2).Value
..End = Cells(12, 2).Value + Cells(14, 2).Value
..Subject = Cells(2, 2).Value
..Location = Cells(16, 2).Value
..Body = Cells(15, 2).Value
..ReminderSet = Cells(20, 2).Value
..Companies = Cells(3, 2).Value
Set itmContact = myFolder.Items.Find(olAppItem.Companies)
olAppItem.Links.Add itmContact
..Categories = Cells(2, 2).Value
On Error GoTo 0
..Save ' saves the new appointment to the default folder
Application.ScreenUpdating = True

MsgBox "This event has been added to your Outlook
Calendar", vbInformation
End With
Set itmContact = Nothing
Set olAppItem = Nothing
Set olApp = Nothing

End Sub

 

[keepitcool]

Savarin,

Check your use of "." when using With constructs.
e.g. to set the item's Start Property

Wrong:

With olAppItem
start = now
End with

Correct:
With olAppItem
.Start = now
End with



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >