? How to get an related Contact Object from an Appointment ?

[Christian Müller]

Hello VBA Family,

I want to write an automated Bill from an Appointment.
It`s works well.
Word get`s all Information from Outlook also the Contact because their is a
Link in the Appointment.
Bad is that I get the Contact as String so when I use restrict it only get
right when the Contact Name is not doubled.
Is there a Method so I can get the Link as Object so that is always right ?
So as the doubleclick in the Appointment always get the related Contact ?

Thanks for your help, sorry about my englisch

Christian


----
Code :

Sub KontaktVonTerminErmitteln()
Set objSelection = Application.ActiveExplorer.Selection
strKontaktname = objSelection(1).Links(1).Name
Dim olOrdner As Outlook.MAPIFolder
Dim olKontakte As Outlook.Items
Dim olKontakt As Outlook.ContactItem
Set olAnw = GetObject(, "Outlook.Application")
'Kontakte-Ordner setzen
Set olOrdner = olAnw.Session.GetDefaultFolder(olFolderContacts)
Set olKontakte = olOrdner.Items
'Scan ansetzen
Set olKontakte = olKontakte.Restrict("[Name] = " & strKontaktname & "")
If olKontakte.Count = 0 Then
MsgBox "Es wurde keine Entsprechung gefunden."
Exit Sub
End If
If olKontakte.Count <> 1 Then
MsgBox "Mehr als ein Kontakt"
End If
Set Kontakt = olKontakte(1)
End Sub

 

[Sue Mosher [MVP-Outlook]]

When in doubt, check the object browser: Press ALt+F11 to open the VBA
environment in Outlook, then press F2. Switch from <All Libraries> to
Outlook to browse all Outlook objects and their properties, methods, and
events. Select any object or member, then press F1 to see its Help topic.

You'll find that not only is there a Links collection but that every Link
has an Item object property that points to the related ContactItem:

On Error Resume Next
Set objLink = MyAppointment.Links(1)
Set objContact = objLink.Item

 

[Christian Müller]

Thanks a lot.
It works fine

Sub KontaktVonTerminErmitteln()
Dim objErstesSelectionElement As Outlook.AppointmentItem
Dim objLinksBeiTermin As Outlook.Link
Set objSelection = Application.ActiveExplorer.Selection
Set objErstesSelectionElement = objSelection.Item(1)
Set objLinksBeiTermin = objErstesSelectionElement.Links(1)
Set Kontakt = objLinksBeiTermin.Item
End Sub

Christian Müller

When in doubt, check the object browser: Press ALt+F11 to open the VBA
environment in Outlook, then press F2. Switch from <All Libraries> to
Outlook to browse all Outlook objects and their properties, methods, and
events. Select any object or member, then press F1 to see its Help topic.

You'll find that not only is there a Links collection but that every Link
has an Item object property that points to the related ContactItem:

On Error Resume Next
Set objLink = MyAppointment.Links(1)
Set objContact = objLink.Item

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

Hello VBA Family,

I want to write an automated Bill from an Appointment.
It`s works well.
Word get`s all Information from Outlook also the Contact because their is
a
Link in the Appointment.
Bad is that I get the Contact as String so when I use restrict it only
get
right when the Contact Name is not doubled.
Is there a Method so I can get the Link as Object so that is always right
?
So as the doubleclick in the Appointment always get the related Contact ?

Thanks for your help, sorry about my englisch

Christian


----
Code :

Sub KontaktVonTerminErmitteln()
Set objSelection = Application.ActiveExplorer.Selection
strKontaktname = objSelection(1).Links(1).Name
Dim olOrdner As Outlook.MAPIFolder
Dim olKontakte As Outlook.Items
Dim olKontakt As Outlook.ContactItem
Set olAnw = GetObject(, "Outlook.Application")
'Kontakte-Ordner setzen
Set olOrdner = olAnw.Session.GetDefaultFolder(olFolderContacts)
Set olKontakte = olOrdner.Items
'Scan ansetzen
Set olKontakte = olKontakte.Restrict("[Name] = " & strKontaktname & "")
If olKontakte.Count = 0 Then
MsgBox "Es wurde keine Entsprechung gefunden."
Exit Sub
End If
If olKontakte.Count <> 1 Then
MsgBox "Mehr als ein Kontakt"
End If
Set Kontakt = olKontakte(1)
End Sub