带有 Excel VBA 的 Outlook 2010 GAL
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18405567/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Outlook 2010 GAL with Excel VBA
提问by user2493043
I have the following code to get contacts out of Outlook from Excel:
我有以下代码可以从 Excel 中获取 Outlook 中的联系人：
Public Sub GetGAL()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.Items
Dim olContact As Outlook.ContactItem
Set olApp = CreateObject("Outlook.Application.14")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderContacts).Items
For Each olContact In olFldr
Debug.Print olContact.FullName
Next olContact
End
End Sub
It is failing on this line saying there is a type mismatch:
在这条线上失败，说存在类型不匹配：
For Each olContact In olFldr
Does anyone know why this is?
有人知道为什么是这样吗？
Also, how do I access the GAL as opposed to just my own contacts?
另外，我如何访问 GAL 而不是我自己的联系人？
Thanks for any help.
谢谢你的帮助。
Edit: Here's my new code to access the addressEntry and ExchangeUser, however, not the country field yet:
编辑：这是我访问 addressEntry 和 ExchangeUser 的新代码，但是，还不是国家/地区字段：
Option Explicit
Public Sub GetGAL()
Application.ScreenUpdating = False
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
Dim i As Long
'Dim sTemp As String
'Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(1)
Set olApp = CreateObject("Outlook.Application.14")
Set olNs = olApp.GetNamespace("MAPI")
Set olGAL = olNs.addressLists("Global Address List").addressEntries
'On Error Resume Next
For i = 1 To olGAL.Count
Set olAddressEntry = olGAL.Item(i)
If olAddressEntry.DisplayType = olRemoteUser Then
Set olUser = olAddressEntry.GetExchangeUser
'Debug.Print olUser.Name & ";" & olUser.StateOrProvince
'Debug.Print sTemp
'ws.Cells(i, 1) = olUser.Name
'ws.Cells(i, 2) = olUser.StateOrProvince
End If
Next i
End
Application.ScreenUpdating = True
End Sub
回答by tigeravatar
Give this a try. Although if you have tons and tons of entries in your GAL, it will take awhile to complete, and you may have to increase the 65000.
试试这个。尽管如果您的 GAL 中有大量条目，则需要一段时间才能完成，并且您可能需要增加 65000。
Sub tgr()
Dim appOL As Object
Dim oGAL As Object
Dim oContact As Object
Dim oUser As Object
Dim arrUsers(1 To 65000, 1 To 2) As String
Dim UserIndex As Long
Dim i As Long
Set appOL = CreateObject("Outlook.Application")
Set oGAL = appOL.GetNameSpace("MAPI").AddressLists("Global Address List").AddressEntries
For i = 1 To oGAL.Count
Set oContact = oGAL.Item(i)
If oContact.AddressEntryUserType = 0 Then
Set oUser = oContact.GetExchangeUser
If Len(oUser.lastname) > 0 Then
UserIndex = UserIndex + 1
arrUsers(UserIndex, 1) = oUser.Name
arrUsers(UserIndex, 2) = oUser.PrimarySMTPAddress
End If
End If
Next i
appOL.Quit
If UserIndex > 0 Then
Range("A2").Resize(UserIndex, UBound(arrUsers, 2)).Value = arrUsers
End If
Set appOL = Nothing
Set oGAL = Nothing
Set oContact = Nothing
Set oUser = Nothing
Erase arrUsers
End Sub
回答by Dmitry Streblechenko
Your code assumes that you can only have ContactItem objects in the folder. It will break if you encounter an object of type DistListItem.
您的代码假定文件夹中只能有 ContactItem 对象。如果您遇到 DistListItem 类型的对象，它将中断。
Declare the item variable as a generic Object, then check the Type property or use TypeName function to figure out the exact item type.
将项目变量声明为通用对象，然后检查 Type 属性或使用 TypeName 函数来确定确切的项目类型。
EDIT: PR_BUSINESS_ADDRESS_COUNTRY DASL name is
编辑：PR_BUSINESS_ADDRESS_COUNTRY DASL 名称是
http://schemas.microsoft.com/mapi/proptag/0x3A26001F
For address entries you can see the DALS property names in OutlookSpy. For example, you can click IMAPISession button, click QueryIdentity, select a property, look at the DASL edit box.
对于地址条目，您可以在OutlookSpy 中看到 DALS 属性名称。例如，您可以单击IMAPISession 按钮，单击QueryIdentity，选择一个属性，查看DASL 编辑框。
