VBA'da Exchange Kullanıcısının Office Konumunu Bul

Question

Birinin kartvizitini Outlook'ta görüntülerken, ofisi konumlarını veren bir Office alanı vardır. Bunu VBA kullanarak nasıl bulabilirim? İşte benim en işlevsel kod: Onların gerçek adı (EG, John Smith) aradıklarında

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 

Bu çalışır, ancak sadece ilk John Smith döndürür. Arama yapmak için e-posta adresini veya takma adını nasıl kullanabilirim?

Not: Intellisense'den yararlanmak için Microsoft Outlook 16.0 Object Library'a bir başvuru ekledim, ancak çalıştıktan sonra geç bağlanmaya geçmeyi planlıyorum.

Answer 1

.Item yöntemi (olGAL.Item(username) satırından) Either the index number of the object, or a value used to match the default property of an object in the collection gerektirdiğinden, Exchange'i e-posta veya diğer adlarla sorgulama yöntemini bulamadım. Ancak, doğru kullanıcıyı aldığımdan emin olmak için bir yol buldum. GAL'ın varsayılan özelliği, benim durumumda (ancak herkesin durumunda olmayabilir ... bunu doğrulamak için iyi belgeler bulamıyor) Active Directory'deki DistinguishedName olan kullanıcının adıdır. Dolayısıyla, kullanıcının SAM hesabını kullanarak arama yaparsam kullanıcının DN'sini alabilirim. Doğru "John Smith" e sahip olduğumdan emin olmak için Exchange'i bu DN ile arayabilirim. Herkes daha iyi, daha hızlı, daha ucuz (AD sunucularını isabet etmez bir) yöntemini varsa

'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 

, bunu duymak isteriz:

İşte benim kombine kodudur.