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