Clever-Excel-Forum

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 Smile

Vielen Dank
Mit freundlichen Grüßen
Philipp

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

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.

lambepil

silex1

lambepil