Ausgewählter Anzeigename aus Adressbuch (global) in Zelle importieren

[lambepil]

Hallo liebe Exceler,

ich erstelle momentan ein Meldeformular für Mitarbeiter. In einem der ersten Schritte soll der Nutzer seinen Namen oder den Namen eines Ansprechpartners auswählen können. Hierzu möchte ich, dass das globale Outlook-Adressbuch aufgerufen wird. Mein Problem besteht nun darin, dass mir der Ansatz fehlt wie ich den ausgewählten Kontakt/Anzeigename aus dem Adressbuch in eine bestimmte Zelle der aktiven Tabelle importieren/kopieren kann.


Meine Funktion:

Code:

'A D R E S S B U C H   Ö F F N E N
Private Sub adressbuch_click()

   'Variablen
   Dim objSession As MAPI.Session
   Dim objRecipients As MAPI.Recipients
   Dim objRecipient As MAPI.Recipient
   Dim objMessage As MAPI.Message
   
   Set objSession = New MAPI.Session
   objSession.Logon
   
   'Adressbuch-Formatierung
   Set objRecipients = objSession.AddressBook( _
       Recipients:=objRecipients, _
       Title:="Wählen Sie Ihren Namen oder den eines Ansprechpartners.", _
       ForceResolution:=False, _
       RecipLists:=1, _
       ToLabel:="Ansprechperson")
           
   'Ausgewählter Anzeigename des Kontaktes in eine bestimmte Zelle importieren
   '...
   
End Sub

Vielleicht hat jemand einen Denkanstoß für mich


Vielen Dank
Mit freundlichen Grüßen
Philipp

[silex1]

Hallo,

also wenn die Daten in eine Listbox geladen werden z.B., dann würde es so aus dieser heraus gehen:

Code:

Private Sub Listbox1_Click(ByVal Cancel As MSForms.ReturnBoolean)
   With ListBox1
       If .ListIndex <> -1 Then
       Range("A1") = .List(.ListIndex)
       Range("B1") = .List(.ListIndex, 1)
       Range("C1") = .List(.ListIndex, 2)
       Range("D1") = .List(.ListIndex, 3)
       Range("E1") = .List(.ListIndex, 4)
       End If
   End With
End Sub

[lambepil]

Danke für die Idee mit der Liste. Mehr durch Zufalle habe ich heute morgen noch einen älteren Forenbeitrag im Office-Forum (Link) gefunden:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$C$5" Then
       
       'Adressbuch öffnen und gewählter Kontakt auslesen
       On Error Resume Next
       
       Dim objSession As New MAPI.Session
       Dim objRecips As MAPI.Recipients
       Dim objRecip As MAPI.Recipient
       Dim sText As String
       
       objSession.Logon , , False, False
       Set objRecips = objSession.AddressBook(, "Wählen Sie einen Namen aus", True, _
       False, 1, "Ansprechperson")
       Set objRecip = objRecips.Item(1)
       
       Range("C5") = objRecip.Name
       
       Set objRecip = Nothing
       Set objRecips = Nothing
       objSession.Logoff
       Set objSession = Nothing
                       
    End If
End Sub

Funktioniert einwandfrei.