如何提取共享Excel中CustomViews关联的Outlook用户名列表？

操作步骤 #

1. 打开你的共享Excel文件，按下Alt+F11打开VBA编辑器
2. 右键点击当前工作簿，选择「插入」→「模块」
3. 将下面的代码粘贴到模块中，根据你的实际情况调整细节（比如视图命名规则、Outlook地址簿名称）
4. 点击运行按钮（或按F5）执行代码，结果会自动生成在新工作表中

VBA代码 #

Sub ExtractCustomViewUsers()
    Dim ws As Worksheet
    Dim cv As CustomView
    Dim i As Integer
    Dim outlookApp As Object
    Dim outlookNS As Object
    Dim addrList As Object
    Dim addrEntry As Object
    Dim userName As String
    Dim userEmail As String
    
    ' 创建新工作表存储结果
    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "视图用户清单"
    ' 设置表头
    ws.Range("A1:C1") = Array("自定义视图名称", "提取的用户名", "匹配的Outlook邮箱")
    ws.Range("A1:C1").Font.Bold = True
    
    i = 2 ' 从第二行开始写入数据
    
    ' 遍历所有自定义视图
    For Each cv In ThisWorkbook.CustomViews
        ws.Range("A" & i).Value = cv.Name
        
        ' 从视图名称提取用户名（请根据你的实际命名规则调整分割逻辑）
        ' 示例规则：视图名称格式为「用户名 - 视图名」
        If InStr(cv.Name, " - ") > 0 Then
            userName = Left(cv.Name, InStr(cv.Name, " - ") - 1)
            ws.Range("B" & i).Value = userName
        Else
            ' 无分隔符时标记需手动核对
            ws.Range("B" & i).Value = "需手动核对: " & cv.Name
        End If
        
        ' 匹配Outlook邮箱
        userEmail = ""
        On Error Resume Next ' 忽略匹配失败的错误
        Set outlookApp = CreateObject("Outlook.Application")
        Set outlookNS = outlookApp.GetNamespace("MAPI")
        Set addrList = outlookNS.AddressLists("全局地址列表") ' 替换为你的Outlook地址簿名称
        
        For Each addrEntry In addrList.AddressEntries
            ' 匹配逻辑：用户名匹配显示名称或别名，可按需调整
            If LCase(addrEntry.Name) = LCase(userName) Or _
               LCase(addrEntry.Alias) = LCase(userName) Then
                userEmail = addrEntry.Address
                Exit For
            End If
        Next addrEntry
        On Error GoTo 0
        
        ws.Range("C" & i).Value = userEmail
        i = i + 1
    Next cv
    
    ' 自动调整列宽
    ws.Columns("A:C").AutoFit
    MsgBox "提取完成，结果已保存到'" & ws.Name & "'工作表", vbInformation
End Sub

注意事项 #

• 视图命名规则：如果你的个人视图命名不是「用户名 - 视图名」格式，修改代码中分割字符串的逻辑（比如换分隔符、调整截取位置）
• Outlook权限：首次运行会触发Outlook安全提示，需允许程序访问地址簿数据
• 地址簿名称：如果你的Outlook全局地址簿名称不是「全局地址列表」，替换代码中对应的字符串

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