vba - 在 Office 365 更新后，VBA 打开全局地址列表不再起作用

Question

我正在使用以下代码打开全局地址窗口，但自从更新到 Office 365 后，它不再打开。我在网上做了很多搜索，但找不到遇到同样问题的人。有人可以帮忙吗？

代码：

Dim cdoSession, cdoAddressBook, olkRecipients, objAE
On Error Resume Next
Set cdoSession = CreateObject("MAPI.Session")
cdoSession.Logon "", "", False, False
Set olkRecipients = cdoSession.AddressBook(, "Global Address List", 0, False)
For Each objAE In olkRecipients
    'MsgBox objAE.Name
    
TextBox1.Value = objAE.Name

Next
Set olkRecipients = Nothing
cdoSession.Logoff
Set cdoSession = Nothing

Answer 1

我添加了对 Microsoft Outlook 16 对象库的引用，然后将代码更新为以下内容，它现在可以正常运行：

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
                ThisName = exchUser.Name
                FirstName = exchUser.FirstName
                LastName = exchUser.LastName
                EmailAddress = exchUser.PrimarySmtpAddress
                '...
                TextBox1.Value = ThisName
            End If
        End If
    End With
Set olApp = Nothing
Set oDialog = Nothing
Set oGAL = Nothing
Set myAddrEntry = Nothing
Set exchUser = Nothing