在VBA中查找交換用戶的辦公位置

在Outlook中查看某人的聯繫人名片時，會出現Office的字段以顯示其位置。我怎樣才能找到使用VBA？這裏是我最實用的代碼：在VBA中查找交換用戶的辦公位置

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

這工作，當我搜索自己的實際名稱（例如，約翰·史密斯），但它只會返回前約翰·史密斯。我如何使用他們的電子郵件地址或別名進行搜索？

注意：我添加了對Microsoft Outlook 16.0 Object Library的引用以充分利用Intellisense，但我計劃在其工作後切換到後期綁定。

來源

2016-03-23 Tim

因此，我還沒有找到通過電子郵件或別名查詢Exchange的方法，因爲.Item方法（從行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。我確實找到了一種方法來確保我獲得了正確的用戶。 GAL的默認屬性是用戶名，在我的情況下（但可能並非每個人都在這種情況下......無法找到很好的文檔來驗證這一點）Active Directory中的DistinguishedName。所以如果我用用戶的SAM賬戶搜索AD，我可以得到用戶的DN。然後，我可以使用該DN搜索Exchange，以確保我擁有正確的「John Smith」。

這裏是我的組合代碼：

'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

如果任何人有一個更好，更快，更便宜的（一個不打AD服務器）的方法，我很樂意聽到它。

來源

2016-03-25 15:39:21 Tim

在VBA中查找交換用戶的辦公位置

回答

相關問題