Exchange-Benutzer OfficeLocation in VBA finden

Question

Wenn Sie die Kontaktkarte von Outlook in Outlook anzeigen, gibt es ein Feld für Office, das ihren Standort angibt. Wie kann ich das mit VBA finden? Hier ist mein funktionellste Code:

Private Function getLocation(username As String) As String 
Dim olApp As Outlook.Application 
Dim olNS As Outlook.Namespace 
Dim olGAL As Outlook.AddressEntries 
Dim olAddressEntry As Outlook.AddressEntry 
Dim olUser As Outlook.ExchangeUser 

Set olApp = New Outlook.Application 
Set olNS = olApp.GetNamespace("MAPI") 
Set olGAL = olNS.AddressLists("Global Address List").AddressEntries 
Set olAddressEntry = olGAL.Item(username) 
Set olUser = olAddressEntry.GetExchangeUser 
Debug.Print olGAL.Count 'count is 646718 
Debug.Print olUser.OfficeLocation 
Debug.Print olUser.Address 
Debug.Print olUser.Name 

getLocation = olUser.OfficeLocation 

Set olApp = Nothing 
Set olNS = Nothing 
Set olGAL = Nothing 
Set olAddressEntry = Nothing 
Set olUser = Nothing 

End Function 

Dies funktioniert, wenn ich für ihre tatsächlichen Namen zu suchen (EG, John Smith), aber es gibt nur den ersten John Smith. Wie kann ich mit ihrer E-Mail-Adresse oder ihrem Alias ​​suchen?

Hinweis: Ich habe einen Verweis auf die Microsoft Outlook 16.0 Object Library hinzugefügt, um Intellisense zu nutzen, aber ich plane, zu später Bindung zu wechseln, sobald es funktioniert.

Answer 1

So habe ich keine Möglichkeit gefunden, Exchange per E-Mail oder Alias ​​abzufragen, weil die .Item Methode (aus der Zeile olGAL.Item(username)) Either the index number of the object, or a value used to match the default property of an object in the collection erfordert. Ich habe jedoch einen Weg gefunden, um sicherzustellen, dass ich den richtigen Benutzer bekomme. Die Standardeigenschaft für die GAL ist der Name des Benutzers, der in meinem Fall (aber möglicherweise nicht in allen Fällen ... keine gute Dokumentation finden kann, um dies zu überprüfen) der DistinguishedName in Active Directory. Wenn ich also AD mit dem SAM-Account des Benutzers suche, kann ich den DN des Benutzers erhalten. Ich kann Exchange dann mit diesem DN durchsuchen, um sicherzustellen, dass ich den richtigen "John Smith" habe.

Hier ist mein Combined Code:

'I pass the username (EG: johnsmit) and get the DN (eg John Smith - VP of Sales). 
' This DN gets passed to the function in my question, and returns the correct location. 
Private Function GetFullName(strUsername As String) As String 
     Dim objConnection As Object 
     Dim objCommand As Object 
     Dim objRecordSet As Object 
     Dim strDN As String 
     Dim temp As Variant 

     Const ADS_SCOPE_SUBTREE = 2 

     Set objConnection = CreateObject("ADODB.Connection") 
     Set objCommand = CreateObject("ADODB.Command") 
     objConnection.Provider = "ADsDSOObject" 
     objConnection.Open "Active Directory Provider" 
     Set objCommand.ActiveConnection = objConnection 

     objCommand.Properties("Page Size") = 1000 
     objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

     objCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://dc=mydomain,dc=com' WHERE objectCategory='user' AND sAMAccountName='" & strUsername & "'" 
     Set objRecordSet = objCommand.Execute 

     objRecordSet.MoveFirst 
     Do Until objRecordSet.EOF 
      strDN = objRecordSet.Fields("distinguishedName").Value 
      temp = Split(strDN, ",") 
      GetFullName = Replace(temp(0), "CN=", "") 
      objRecordSet.MoveNext 
     Loop 

     objConnection.Close 
     Set objConnection = Nothing 
     Set objCommand = Nothing 
     Set objRecordSet = Nothing 
End Function 

Wenn jemand eine bessere hat, schneller, billiger (eine, die nicht den AD-Server nicht trifft) Methode, würde ich gerne hören.