Outlook 2013 VBA 从全局地址列表中获取所需数据
Outlook 2013 VBA Getting required data from Global Address List
我正在使用 Outlook VBA 代码通过全局地址列表中的唯一职位查找特定的电子邮件地址。我有下面的代码,但我不确定如何识别特定的电子邮件地址。我将其用作函数,以便可以在子例程中调用它。
我一直收到错误 "Object variable or With block variable not set",但我不知道如何编辑代码以消除错误。我在这一行收到错误:"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
任何帮助将不胜感激!!
我已经想出了如何获取带有职位名称的电子邮件地址,如下所示:
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
我正在使用 Outlook VBA 代码通过全局地址列表中的唯一职位查找特定的电子邮件地址。我有下面的代码,但我不确定如何识别特定的电子邮件地址。我将其用作函数,以便可以在子例程中调用它。
我一直收到错误 "Object variable or With block variable not set",但我不知道如何编辑代码以消除错误。我在这一行收到错误:"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
任何帮助将不胜感激!!
我已经想出了如何获取带有职位名称的电子邮件地址,如下所示:
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