Mut*_*tor 3 excel vba excel-vba outlook-vba
我在Excel中有一个名字和姓氏的列表,我想利用该列表在Outlook中使用visual basic查找电子邮件地址.
我正在使用以下VB代码:
    Private Sub GetAddresses()
    Dim o, AddressList, AddressEntry
    Dim c As Range, r As Range, AddressName As String
    Set o = CreateObject("Outlook.Application")
    Set AddressList = o.Session.AddressLists("Global Address List")
    Set r = Range("a1:a3")
    For Each c In r
        AddressName = Trim(c.Value) & ", " & Trim(c.Offset(0, 1).Value)
        For Each AddressEntry In AddressList.AddressEntries
            If AddressEntry.Name = AddressName Then
                c.Offset(0, 2).Value = AddressEntry.Address
                Exit For
            End If
        Next AddressEntry
    Next c
    End Sub
Run Code Online (Sandbox Code Playgroud)
代码似乎工作正常,直到实际检索电子邮件地址.在匹配名称后,返回以下内容而不是地址.有没有人知道我做错了什么.
/O=Compnay/OU=Company/cn=Recipients/cn=shs
Run Code Online (Sandbox Code Playgroud)
在此先感谢您的帮助.
我假设这些是域用户.您想从exchangeUser对象获取SMTP地址.我已更新您的代码以显示此信息.
Private Sub GetAddresses()
    Dim o, AddressList, AddressEntry
    Dim c As Range, r As Range, AddressName As String
    'added variable for exchange user object
    Dim exchangeUser As Outlook.exchangeUser
    Set o = CreateObject("Outlook.Application")
    Set AddressList = o.Session.AddressLists("Global Address List")
    Set r = Range("a1:a3")
    For Each c In r
        AddressName = Trim(c.Value) ' & ", " & Trim(c.Offset(0, 1).Value)
        For Each AddressEntry In AddressList.AddressEntries
            If AddressEntry.Name = AddressName Then
            'set the exchange user object
            Set exchangeUser = AddressEntry.GetExchangeUser
            'get the smtp addresss
            c.Offset(0, 2).Value = exchangeUser.PrimarySmtpAddress
            'release
            Set exchangeUser = Nothing
                Exit For
            End If
        Next AddressEntry
    Next c
End Sub
Run Code Online (Sandbox Code Playgroud)