根据别名检索 Outlook 详细信息 Excel VBA
Retrieve Outlook details based on alias name Excel VBA
我有一个组织中所有员工的员工 ID 列表。我想要 Excel VBA 代码来获取名字、姓氏、指定联系人# 和部门等详细信息。
别名是员工 ID。因此,代码应将员工 ID 作为别名,并在 Outlook 中搜索上述各个详细信息。
网上找了个宏,按我的要求修改:
Sub tgr()
Dim appOL As Object
Dim oGAL As Object
Dim oContact As Object
Dim oUser As Object
Dim UserIndex As Long
Dim i As Long
Dim j As Integer
Set appOL = CreateObject("Outlook.Application")
Set oGAL = appOL.GetNamespace("MAPI").AddressLists("/Name of the Distribution List/").AddressEntries
On Error Resume Next
For j = 2 To Application.WorksheetFunction.CountA(Columns(1))
For i = 1 To oGAL.Count
Set oContact = oGAL.Item(i)
If oContact.AddressEntryUserType = 0 Then
Set oUser = oContact.GetExchangeUser
If UCase(oUser.FirstName) = UCase(Range("A" & j).Value) And UCase(oUser.LastName) = UCase(Range("B" & j).Value) Then
Range("c" & j).Value = oUser.Alias
Range("D" & j).Value = oUser.JobTitle
Range("E" & j).Value = oUser.Department
Range("F" & j).Value = oUser.ManagerName
i = oGAL.Count
End If
End If
Next i
Next j
Set oGAL = Nothing
Set oContact = Nothing
Set oUser = Nothing
End Sub
该代码有效,但问题是它每次都会检查地址列表中的所有项目以搜索每个项目。这需要更多时间。
有没有一种方法可以通过广泛搜索而不是查看地址列表中的每个项目并进行比较来简化它。类似于 Addresslist.find。好吧,只有在联系人文件夹中搜索地址列表没有 FIND 属性.
时,propety find 才有效
过去,我在 Excel 中使用 ADSI VBScripts 或 ADO+VBA 从域而不是 Outlook 中查找这些详细信息。一个例子是:
Dim adoConnection As ADODB.Connection
Set adoConnection = New ADODB.Connection
With adoConnection
.Provider = "ADsDSOObject"
.CursorLocation = adUseClient
.Open "Active Directory Provider"
End With
Dim adoCommandText As String
adoCommandText = "<LDAP://DC=company, DC=co, DC=uk>" & _
"; (& (objectCategory=person) (mail=" & EmailAddress & ")); " & _
"sAMAccountName, cn, givenName; subtree")
Dim adoCommand As ADODB.Command
Dim adoReturnRecordset As ADODB.Recordset
Set adoCommand = New ADODB.Command
With adoCommand
.ActiveConnection = adoConnection
.CommandType = adCmdText
.CommandText = adoCommandText
Set adoReturnRecordset = .Execute
End With
' read the data returned by using ADQueryReturnRecordset.Fields(0) etc.
如果您完全确定这需要在 VBA 内完成,https://msdn.microsoft.com/en-us/library/ms810638.aspx 页面可以帮助您开始使用 ADO 路线。
但是,现在是 2015 年,我建议可能会考虑使用 powershell,它可以从 Active Directory(和 Exchange)中查找详细信息,作为使用 VBA 的替代方法。是否有任何原因 (1) 您需要为此使用 VBA 以及 (2) 为什么您要从 Outlook 而不是 AD/Exchange 查找这些详细信息?
Windows 登录别名中的别名?尝试 Namespace.ResolveName - GAL 提供商将根据登录别名进行解析。
我有一个组织中所有员工的员工 ID 列表。我想要 Excel VBA 代码来获取名字、姓氏、指定联系人# 和部门等详细信息。
别名是员工 ID。因此,代码应将员工 ID 作为别名,并在 Outlook 中搜索上述各个详细信息。
网上找了个宏,按我的要求修改:
Sub tgr()
Dim appOL As Object
Dim oGAL As Object
Dim oContact As Object
Dim oUser As Object
Dim UserIndex As Long
Dim i As Long
Dim j As Integer
Set appOL = CreateObject("Outlook.Application")
Set oGAL = appOL.GetNamespace("MAPI").AddressLists("/Name of the Distribution List/").AddressEntries
On Error Resume Next
For j = 2 To Application.WorksheetFunction.CountA(Columns(1))
For i = 1 To oGAL.Count
Set oContact = oGAL.Item(i)
If oContact.AddressEntryUserType = 0 Then
Set oUser = oContact.GetExchangeUser
If UCase(oUser.FirstName) = UCase(Range("A" & j).Value) And UCase(oUser.LastName) = UCase(Range("B" & j).Value) Then
Range("c" & j).Value = oUser.Alias
Range("D" & j).Value = oUser.JobTitle
Range("E" & j).Value = oUser.Department
Range("F" & j).Value = oUser.ManagerName
i = oGAL.Count
End If
End If
Next i
Next j
Set oGAL = Nothing
Set oContact = Nothing
Set oUser = Nothing
End Sub
该代码有效,但问题是它每次都会检查地址列表中的所有项目以搜索每个项目。这需要更多时间。
有没有一种方法可以通过广泛搜索而不是查看地址列表中的每个项目并进行比较来简化它。类似于 Addresslist.find。好吧,只有在联系人文件夹中搜索地址列表没有 FIND 属性.
时,propety find 才有效过去,我在 Excel 中使用 ADSI VBScripts 或 ADO+VBA 从域而不是 Outlook 中查找这些详细信息。一个例子是:
Dim adoConnection As ADODB.Connection
Set adoConnection = New ADODB.Connection
With adoConnection
.Provider = "ADsDSOObject"
.CursorLocation = adUseClient
.Open "Active Directory Provider"
End With
Dim adoCommandText As String
adoCommandText = "<LDAP://DC=company, DC=co, DC=uk>" & _
"; (& (objectCategory=person) (mail=" & EmailAddress & ")); " & _
"sAMAccountName, cn, givenName; subtree")
Dim adoCommand As ADODB.Command
Dim adoReturnRecordset As ADODB.Recordset
Set adoCommand = New ADODB.Command
With adoCommand
.ActiveConnection = adoConnection
.CommandType = adCmdText
.CommandText = adoCommandText
Set adoReturnRecordset = .Execute
End With
' read the data returned by using ADQueryReturnRecordset.Fields(0) etc.
如果您完全确定这需要在 VBA 内完成,https://msdn.microsoft.com/en-us/library/ms810638.aspx 页面可以帮助您开始使用 ADO 路线。
但是,现在是 2015 年,我建议可能会考虑使用 powershell,它可以从 Active Directory(和 Exchange)中查找详细信息,作为使用 VBA 的替代方法。是否有任何原因 (1) 您需要为此使用 VBA 以及 (2) 为什么您要从 Outlook 而不是 AD/Exchange 查找这些详细信息?
Windows 登录别名中的别名?尝试 Namespace.ResolveName - GAL 提供商将根据登录别名进行解析。