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

kangatang

hlm750908 发表于 2011-11-15 23:34
Const CdoPR_EMS_AB_PROXY_ADDRESSES = &H800F101E

谢谢 hlm兄，但是运行你的代码后，
Run Error:

Object Recquired

For Each v In objField.Value

以上语句出现错误。
怎么回事？

hlm750908

'创建记录集
Sub CreateRst()
    Set rstAddress = New ADODB.Recordset
    With rstAddress.Fields
        .Append "name", adBSTR
        .Append "PrimarySmtpAddress", adBSTR
    End With
    rstAddress.Open
End Sub
Sub getAddress_For_ALL()
    '此代码调用微软cdo 1.21 库 但可以用于所有的outlook版本 outlook2003 ,outlook2010
    CreateRst
    Dim objSession As MAPI.Session
    Dim objAddressEntryries As MAPI.AddressEntries
    Dim objAddressEntry As MAPI.AddressEntry
    Dim objField As MAPI.Field
    Set objSession = CreateObject("MAPI.Session")
    objSession.Logon , , False, False
    Set objAddressEntryries = objSession.GetAddressList(CdoAddressListGAL).AddressEntries
    Dim i As Long
    '    Dim v                                                                       'As Object
    For i = 1 To objAddressEntryries.Count
        Set objAddressEntry = objAddressEntryries.Item(i)
        OutputDebugString "插件" & i & "=====================================开始"
        OutputDebugString "插件 邮件名称" & objAddressEntry.Name
        OutputDebugString "插件 直接取邮件地址" & objAddressEntry.Fields(972947486).Value
        OutputDebugString "插件" & i & "=====================================结束"
        If objAddressEntry.DisplayType = CdoDisplayType.CdoUser Or objAddressEntry.DisplayType = CdoDisplayType.CdoRemoteUser Then
            rstAddress.AddNew
            rstAddress(0) = objAddressEntry.Name
            rstAddress(1) = objAddressEntry.Fields(972947486).Value
        End If
    Next
    rstAddress.Update
    OutputDebugString "插件 全部邮件地址总条数" & i
    OutputDebugString "插件 符合条件邮件地址总条数" & rstAddress.RecordCount
End Sub

Sub getAddress_For_2010()
    '此代码无需调用cdo.dll,但只支持outlook2010(系统没有安装outlook2010 编译并不会报错)
    CreateRst
    Dim objAddressEntries As Outlook.AddressEntries
    Dim objAddressEntry As Outlook.AddressEntry
    Set objAddressEntries = olApp.Session.GetGlobalAddressList.AddressEntries
    Dim i As Long
    For i = 1 To objAddressEntries.Count - 1
        Set objAddressEntry = objAddressEntries.GetNext
        If objAddressEntry.DisplayType = olUser Then
            rstAddress.AddNew
            rstAddress(0) = objAddressEntry.Name
            rstAddress(1) = objAddressEntry.GetExchangeUser.PrimarySmtpAddress
        End If
    Next
    rstAddress.Update
End Sub

kangatang

hlm750908 发表于 2011-12-10 13:36
'创建记录集
Sub CreateRst()
    Set rstAddress = New ADODB.Recordset

下周到公司电脑上去试试，谢谢。

kangatang

hlm750908 发表于 2011-12-10 13:36
'创建记录集
Sub CreateRst()
    Set rstAddress = New ADODB.Recordset

还是不行，给个附件吧。

hlm750908

这个是 一个vb工程
获取全球通讯簿 全部相关的代码

1.模块中申明  Public Declare Sub OutputDebugString Lib "Kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As String)


2.在上面的代码 模块或者 类模块内 申明  Dim rstAddress As ADODB.Recordset

主意 必须要 加入上面的引用

有错 的话 你贴报错信息啊

kangatang

hlm750908 发表于 2011-12-27 08:39
这个是 一个vb工程
获取全球通讯簿 全部相关的代码

谁有英文版VB 6.0编译器？（Visual Basic Compiler）？实在是找不到了。网上下载了几次都是骗人的恶意软件。

求助贴：
http://club.excelhome.net/thread-770695-1-1.html

hlm750908

刚好公司 需要发送邮件
写了个


里面 有  查 全球通讯薄的 代码
给你 参考

cdo 1.21 传不上来