Outlook 2013 VBA正在从全局地址列表获取所需数据

我正在使用Outlook VBA代码通过全局地址列表中唯一的职务名称查找特定的电子邮件地址。我有下面的代码，但我不确定我如何才能把特定电子邮件地址的识别用绳子绑起来。我把它作为一个函数，这样我就可以在子程序中调用它

我一直收到错误“objectvariable或With block variable not set”，但我不知道如何在代码中进行编辑以删除错误。我在这一行得到错误：“Set olUser=olAddressEntry.GetExchangeUser”

---

任何帮助都将不胜感激

我已经想出了如何获得带有职位名称的电子邮件地址，如下所示：

Function GALEmail(specificTitle As String) As String

Dim olNs As Outlook.NameSpace
Dim olGAL As Object
Dim olAddressEntry As Object
Dim olUser As Object
Dim sEmail As String
Dim i As Long
Dim GetCurrentItem As Object

Set olNs = Application.GetNamespace("MAPI")
Set olGAL = olNs.AddressLists("Global Address List").AddressEntries
Set GetCurrentItem = Application.ActiveInspector.currentItem

'On Error Resume Next
With GetCurrentItem
    For i = 1 To olGAL.Count
        Set olAddressEntry = olGAL.Item(i)

        If olAddressEntry.AddressEntryUserType = 0 Then
        Set olUser = olAddressEntry.GetExchangeUser
        sEmail = olUser.JobTitle

            If sEmail = specificTitle Then
                GALEmail = olUser.PrimarySmtpAddress
            End If
        End If
    Next i
End With

End Function

---

首先，函数不返回值。其次，在GAL中循环所有项目不是一个好主意，尤其是如果您使用的是在线配置文件。您建议我怎么做，而不是循环浏览这些项目？仅在OOM中您无法做太多事情-您需要使用扩展MAPI（仅限C++或Delphi）或Redemption（任何语言）来使用GAL容器的MAPITable对象。我明白了。但是，我仅使用VBA实现此功能。但我可以尝试在将来增强此功能。不过，谢谢你的推荐！请记住，您的代码将适用于GAL中的大约100个项目。如果有更多的地址条目（我看到公司GAL容器中的条目超过100000个），那么您的代码运行速度将非常慢。

Function GALEmail(specificTitle As String) As String

Dim olNs As Outlook.NameSpace
Dim olGAL As Object
Dim olAddressEntry As Object
Dim olUser As Object
Dim sEmail As String
Dim i As Long
Dim GetCurrentItem As Object

Set olNs = Application.GetNamespace("MAPI")
Set olGAL = olNs.AddressLists("Global Address List").AddressEntries
Set GetCurrentItem = Application.ActiveInspector.currentItem

'On Error Resume Next
With GetCurrentItem
    For i = 1 To olGAL.Count
        Set olAddressEntry = olGAL.Item(i)

        If olAddressEntry.AddressEntryUserType = 0 Then
        Set olUser = olAddressEntry.GetExchangeUser
        sEmail = olUser.JobTitle

            If sEmail = specificTitle Then
                GALEmail = olUser.PrimarySmtpAddress
            End If
        End If
    Next i
End With

End Function