Hallo,
Ich möchte gerne in einer Zelle in Excel z.B. A1 die globale Adressliste von Outlook nach einem Benutzer durchsuchen und falls mehrere Namen wie Mustermann vorhanden sind, alle Vorschlage angezeigt bekommen (z.B. Max Mustermann, Heinz Mustermann usw.). Anschließend soll nach dem Anklicken des richtigen Benutzers die E-Mail-Adresse des Benutzers in Zelle A1 geschrieben werden. Ich habe das alles schon mit einer Schleife gemacht, jedoch dauert das bei 30.000 Adressen ziemlich lange. Ich habe ein Programmcode im Forum gefunden, der leider nur den ersten gefundenen Namen wiedergibt, jedoch nicht alle auflistet. Kann mir jemand bei dem Thema eventuell helfen?
Aufgrund der Kompatibilität der Office-Versionen sollte der Code in Late Binding aufgebaut werden.
Im Forum habe ich diesen Code gefunden, der leider nur den ersten gefundenen Namen wiedergibt, jedoch nicht alle auflistet.
Function GetMail(strRcpt As String) As String
Dim outApp As Outlook.Application
Dim outNms As Outlook.Namespace
Dim outAddr As Outlook.AddressList
Dim outRcpt As Outlook.AddressEntry
On Error GoTo MailError
Set outApp = New Outlook.Application
Set outNms = outApp.GetNamespace("MAPI")
Set outAddr = outNms.AddressLists("Globale Adressliste")
Set outRcpt = outAddr.AddressEntries(strRcpt)
GetMail = outRcpt.GetExchangeUser.PrimarySmtpAddress
Exit Function
MailError:
MsgBox "An error occures in modul: " & Application.VBE.ActiveCodePane.CodeModule.Name & _
vbCrLf & _
"Error number: " & Err.Number & vbCrLf & "Describtion: " & Err.Description
On Error Resume Next
Set outApp = Nothing
Set outNms = Nothing
Set outAddr = Nothing
Set outRcpt = Nothing
End
End Function