如何通过VBA利用用户Alias查询Exchange用户的直属经理？

你现有的代码仅能查询当前登录用户的直属经理，要实现通过输入用户Alias查询对应Exchange用户经理并发送邮件，可参考以下VBA代码：

Sub GetManagerByAliasAndSendEmail()
    Dim outlookApp As Object
    Dim namespaceObj As Object
    Dim addressList As Object
    Dim addressEntry As Object
    Dim exchangeUser As Object
    Dim managerUser As Object
    Dim targetAlias As String
    Dim mailItem As Object
    
    ' 获取用户输入的目标Alias
    targetAlias = InputBox("请输入要查询的用户Alias:", "输入用户Alias")
    If targetAlias = "" Then Exit Sub
    
    Set outlookApp = CreateObject("Outlook.Application")
    Set namespaceObj = outlookApp.GetNamespace("MAPI")
    
    ' 遍历全局地址列表查找目标用户
    For Each addressList In namespaceObj.AddressLists
        ' 注意：中文环境全局地址列表名称为"全局地址列表"，英文环境改为"Global Address List"
        If addressList.Name = "全局地址列表" Then
            For Each addressEntry In addressList.AddressEntries
                ' 筛选Exchange类型的用户条目（AddressEntryUserType=0）
                If addressEntry.AddressEntryUserType = 0 Then
                    Set exchangeUser = addressEntry.GetExchangeUser
                    If Not exchangeUser Is Nothing Then
                        ' 匹配目标Alias，如需不区分大小写可改用LCase(exchangeUser.Alias) = LCase(targetAlias)
                        If exchangeUser.Alias = targetAlias Then
                            Set managerUser = exchangeUser.Manager
                            If Not managerUser Is Nothing Then
                                ' 创建邮件并发送给经理
                                Set mailItem = outlookApp.CreateItem(0) ' 0代表邮件项
                                With mailItem
                                    .To = managerUser.PrimarySmtpAddress
                                    .Subject = "关于" & exchangeUser.Name & "的事项通知"
                                    .Body = "您好，这是关于" & exchangeUser.Name & "的相关邮件内容，请查收。"
                                    ' 如需添加附件，取消下方注释并替换路径
                                    ' .Attachments.Add "C:\YourFilePath\Example.pdf"
                                    .Send ' 直接发送；如需先预览邮件，改为.Display
                                End With
                                MsgBox "已成功向" & managerUser.Name & "发送邮件！"
                            Else
                                MsgBox "用户 " & targetAlias & " 无直属经理信息。"
                            End If
                            Exit Sub ' 找到目标用户后退出循环
                        End If
                    End If
                End If
            Next addressEntry
        End If
    Next addressList
    
    MsgBox "未找到Alias为 " & targetAlias & " 的Exchange用户。"
    
    ' 释放对象资源
    Set mailItem = Nothing
    Set managerUser = Nothing
    Set exchangeUser = Nothing
    Set addressEntry = Nothing
    Set addressList = Nothing
    Set namespaceObj = Nothing
    Set outlookApp = Nothing
End Sub

关键说明 #

• Alias匹配：代码通过exchangeUser.Alias精准匹配目标用户，如需忽略大小写，可将匹配逻辑改为LCase(exchangeUser.Alias) = LCase(targetAlias)
• 地址列表适配：全局地址列表名称需根据Outlook语言环境调整，英文环境请替换为"Global Address List"
• 邮件定制：可根据需求修改邮件的主题、正文、附件等内容；若不想直接发送，将.Send改为.Display即可打开邮件编辑窗口
• 异常处理：代码覆盖了三种场景：找到用户且有经理、找到用户但无经理、未找到目标用户，均会给出对应提示

内容的提问来源于stack exchange，提问作者cage4000