VBA:如何获取当前outlook用户的SMTP电子邮件地址列表？

Sub GetSMTPAddresses()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olAccounts As Outlook.Accounts
    Dim olAccount As Outlook.Account
    Dim smtpAddresses As String
    
    ' 创建Outlook应用程序对象
    Set olApp = New Outlook.Application
    
    ' 获取Outlook命名空间
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' 获取当前用户的所有账户
    Set olAccounts = olNamespace.Accounts
    
    ' 遍历每个账户
    For Each olAccount In olAccounts
        ' 判断账户类型是否为SMTP
        If olAccount.AccountType = olSmtp Then
            ' 将SMTP地址添加到列表中
            smtpAddresses = smtpAddresses & olAccount.SmtpAddress & vbCrLf
        End If
    Next olAccount
    
    ' 显示SMTP地址列表
    MsgBox "SMTP Addresses:" & vbCrLf & smtpAddresses
    
    ' 释放对象
    Set olAccount = Nothing
    Set olAccounts = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
End Sub