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

Question

I am using Outlook VBA codes to find a specific Email address by the unique job title in the Global Address List. I have the code below, but I am not sure how I can rope the identifying of specific Email address in. I am using this as a Function so that I can call it in the Subroutine.

I keep getting the error "Object variable or With block variable not set", but I don't know how I can edit in the code to remove the error. I get the error at this line: "Set olUser = olAddressEntry.GetExchangeUser".

Function GALEmail(specificTitle As String) As String

Dim olNs As Outlook.NameSpace
Dim olGAL As Outlook.AddressEntries
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
Set olUser = Nothing

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

        If sEmail = specificTitle Then
            Set olUser = olAddressEntry.GetExchangeUser
            Debug.Print olUser.Email1Address
        End If
    Next i
End With

End Function

Any help would be greatly appreciated!!

Answer 1

I have figured how to get the Email Address with the job title as shown below:

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