如果关联名称包含字符串，如何从Outlook VBA中的全局地址列表中提取电子邮件地址

Sub ExtractEmailAddresses()
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olGAL As Outlook.AddressList
    Dim olEntries As Outlook.AddressEntries
    Dim olEntry As Outlook.AddressEntry
    Dim strSearch As String
    
    ' 设置搜索字符串
    strSearch = "关联名称包含的字符串"
    
    ' 创建Outlook应用程序对象
    Set olApp = New Outlook.Application
    
    ' 获取Outlook命名空间
    Set olNS = olApp.GetNamespace("MAPI")
    
    ' 获取全局地址列表
    Set olGAL = olNS.AddressLists("全局地址列表")
    
    ' 获取地址列表中的所有条目
    Set olEntries = olGAL.AddressEntries
    
    ' 遍历所有条目，提取符合条件的电子邮件地址
    For Each olEntry In olEntries
        If InStr(1, olEntry.Name, strSearch, vbTextCompare) > 0 Then
            Debug.Print olEntry.Address
        End If
    Next olEntry
    
    ' 释放对象
    Set olEntry = Nothing
    Set olEntries = Nothing
    Set olGAL = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub