从 Excel 打开 Outlook 通讯簿

Question

我在 Excel 2010 中使用 VBA，使用 Outlook 2010（已打开）。

我怎么能写一个这样的子：

1 Outlook 通讯簿打开；
2 用户选择一个联系人并点击确定；
3 联系人的名字、姓氏和电子邮件地址是否存储在活动工作表的单元格中？

我试过这个方法没有成功：SelectNamesDialog Object

另外我不确定是否需要使用：Application.GetNamespace("MAPI")

Answer 1

您走对了，SelectNamesDialog 正是您要找的。 GetNamepsace方法等同于示例代码中使用的Session属性：

 Sub ShowContactsInDialog()
  Dim oDialog As SelectNamesDialog
  Dim oAL As AddressList
  Dim oContacts As Folder

  Set oDialog = Application.Session.GetSelectNamesDialog
  Set oContacts = _
    Application.Session.GetDefaultFolder(olFolderContacts)

  'Look for the address list that corresponds with the Contacts folder
  For Each oAL In Application.Session.AddressLists
    If oAL.GetContactsFolder = oContacts Then
        Exit For
    End If
  Next
  With oDialog
    'Initialize the dialog box with the address list representing the Contacts folder
    .InitialAddressList = oAL
    .ShowOnlyInitialAddressList = True
    If .Display Then
        'Recipients Resolved
        'Access Recipients using oDialog.Recipients
    End If
  End With
 End Sub

您可能会发现以下文章有帮助：

Answer 2

以下是如何从 GAL 中的选定联系人获取所有详细信息：

您需要打开全局地址列表而不是联系人文件夹中的联系人，并使用 Outlook.ExchangeUser 对象，如 this page 中所述：请参阅 David Zemens 的最后回答。

Private Sub cmdSetProjectMember1_Click()

    Dim olApp As Outlook.Application
    Dim oDialog As SelectNamesDialog
    Dim oGAL As AddressList
    Dim myAddrEntry As AddressEntry
    Dim exchUser As Outlook.ExchangeUser

    Dim AliasName As String
    Dim FirstName As String
    Dim LastName As String
    Dim EmailAddress As String

    Set olApp = GetObject(, "Outlook.Application")
    Set oDialog = olApp.Session.GetSelectNamesDialog
    Set oGAL = olApp.GetNamespace("MAPI").AddressLists("Global Address List")

    With oDialog
        .AllowMultipleSelection = False
        .InitialAddressList = oGAL
        .ShowOnlyInitialAddressList = True
        If .Display Then
            AliasName = oDialog.Recipients.Item(1).Name
            Set myAddrEntry = oGAL.AddressEntries(AliasName)
            Set exchUser = myAddrEntry.GetExchangeUser

            If Not exchUser Is Nothing Then
                FirstName = exchUser.FirstName
                LastName = exchUser.LastName
                EmailAddress = exchUser.PrimarySmtpAddress
                '...
                MsgBox "You selected contact: " & vbNewLine & _
                    "FirstName: " & FirstName & vbNewLine & _
                    "LastName:" & LastName & vbNewLine & _
                    "EmailAddress: " & EmailAddress
            End If
        End If
    End With
Set olApp = Nothing
Set oDialog = Nothing
Set oGAL = Nothing
Set myAddrEntry = Nothing
Set exchUser = Nothing
End Sub

从 Excel 打开 Outlook 通讯簿

Opening Outlook address book from Excel

excel

outlook

vba

excel-2010