时间戳

首页 > 解决方案 > 从您的 Outlook 2007 中获取所有分发列表

vba - 从您的 Outlook 2007 中获取所有分发列表

问题描述

我需要获取我在 Outlook 2007 中创建的所有通讯组列表，而无需实际查看我的所有联系人。

标签： vbaoutlook

解决方案

尝试运行此代码并让我知道它是否适合您。基本上，它会从 Outlook 中提取您所有的全球地址联系人（带有附加信息）并将它们放在新表上。打开 vba 模块，在任务栏中选择“工具”（“运行”旁边）。接下来，选择“参考”。向下直到看到“MICROSOFT OUTLOOK 16.0 Object Library”并检查它。希望这是有道理的。

Dim olApp As Outlook.Application
Dim olNameSpace     As Namespace
Dim olAddrList      As AddressList
Dim olAddrEntry     As AddressEntry
Dim olExchgnUser    As ExchangeUser
Dim sh              As Worksheet
Dim lCnt            As Long

Set olApp = CreateObject("Outlook.Application")
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olAddrList = olNameSpace.AddressLists("Global Address List")


Set sh = ThisWorkbook.Worksheets.Add


With sh
    .Cells(1, 1) = "NAME"
    .Cells(1, 2) = "FIRST NAME"
    .Cells(1, 3) = "LAST NAME"
    .Cells(1, 4) = "ALIAS"
    .Cells(1, 5) = "JOB TITLE"
    .Cells(1, 6) = "DEPARTMENT"
End With


lCnt = 2

For Each olAddrEntry In olAddrList.AddressEntries


    Set olExchgnUser = olAddrEntry.GetExchangeUser

    On Error Resume Next

    With olExchgnUser
        sh.Cells(lCnt, 1) = .Name
        sh.Cells(lCnt, 2) = .FirstName
        sh.Cells(lCnt, 3) = .LastName
        sh.Cells(lCnt, 4) = .Alias
        sh.Cells(lCnt, 5) = .JobTitle
        sh.Cells(lCnt, 6) = .Department
    End With

    Application.StatusBar = "Processing contact " & lCnt & "..."

    If Err.Number = 0 Then lCnt = lCnt + 1
    Err.Clear
    On Error GoTo 0

Next olAddrEntry
Application.StatusBar = ""

MsgBox "Outlook Extraction Complete",vbinformation,"Outlook Extraction"

End Sub

推荐阅读