请教如何获取Global address list的邮箱地址

kangatang

为讨教得更清楚，特制作了两个附件，
其中一个包含了CDO.DLL，请将两附件解压到指定文件后运行EXE文件，完成自动注册。
然后打开xls文件，运行宏。
(点击EXE文件后，除xls文件外，其他文件都可删除)

我现在的问题是
1, 如何批量导出在一张sheet上?(附件只能一个一个查)
2, 怎样让运行过程不弹出任何窗体。
3, 其他想到了我再讨教。
CDO.rar (269.93 KB, 下载次数: 24)

2011-8-11 17:03 上传

点击文件名下载附件

请解压后运行.rar (57.27 KB, 下载次数: 32)

2011-8-11 17:03 上传

点击文件名下载附件

[ 本帖最后由 kangatang 于 2011-8-11 17:20 编辑 ]

dsd999

看看我的这个帖子，看能不能满足你的要求。

http://club.excelhome.net/thread-555577-1-1.html

kangatang

dsd999 发表于 2011-8-12 09:10
看看我的这个帖子，看能不能满足你的要求。

http://club.excelhome.net/thread-555577-1-1.html

老师，试用您给的方法，不能导出Global Address List里面的信息。
我在网上看了下，据说要用到CDO.DLL。如我附件所示。

EH里面也一直有人想了解导出Global Address List的方法，看看我的要求能否实现。

dsd999

能否把你的Global Address List 截图传上来？

Gemmy

需要引用Microsoft Office Outlook  Object x.x library
把GAL里面的所有人员信息导入excel

1. Sub GetGALUserList()
   
2. Dim oGAL As AddressList
   
3. Set oGAL = GetObject("", "Outlook.application").GetNamespace("MAPI").AddressLists.Item("Global Address List")
   
4. Dim oEntry As AddressEntry, oEachUser As ExchangeUser
   
5. 
   
6. i = 2
   
7. On Error Resume Next
   
8. For Each oEntry In oGAL.AddressEntries
   
9. If oEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
   
10. Set oEachUser = oEntry.GetExchangeUser()
    
11. Cells(i, 1).Select
    
12. Cells(i, 1) = oEachUser.Alias
    
13. Cells(i, 2) = oEachUser.PrimarySmtpAddress
    
14. Cells(i, 3) = oEachUser.City
    
15. Cells(i, 4) = oEachUser.BusinessTelephoneNumber
    
16. i = i + 1
    
17. End If
    
18. Next
    
19. End Sub

复制代码

kangatang

dsd999 发表于 2011-8-15 13:28
能否把你的Global Address List 截图传上来？

C:\Documents and Settings\kangatang\Desktop\global list.JPG

如上。

这几天没上网，回复晚了。

kangatang

重发。

hlm750908

        Dim objSession As MAPI.Session
        
        Set objSession = CreateObject("MAPI.Session")
        objSession.Logon , , False, False
        
        Dim objAddressEntries As MAPI.AddressEntries
        Dim objaddressent As MAPI.AddressEntry
        Dim objField As MAPI.Field
        Dim objFields As MAPI.Fields
        Set objAddressEntries = objSession.GetAddressList(CdoAddressListGAL).AddressEntries

        Dim i As Long
        Dim v As Object
        For i = 1 To objAddressEntries.Count
            Set objaddressent = objAddressEntries.Item(i)
            Debug.Print i & "=====================================开始"
            Set objField = objaddressent.Fields(CdoPR_EMS_AB_PROXY_ADDRESSES)

            Debug.Print objaddressent.Name

            For Each v In objField.Value
                Debug.Print "邮件地址: " & v
            Next
            Debug.Print i & "=====================================结束"
        Next
        Debug.Print i
        Exit Sub

hlm750908

Const CdoPR_EMS_AB_PROXY_ADDRESSES = &H800F101E

chen9634

学学,我也想知道