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



------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/