Question

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

Answer 1

尝试运行此代码，让我知道它是否适合您。基本上，它会从Outlook中拉出所有全局地址联系人（以及其他信息），并将它们放到新的表格上。打开vba模块，然后在任务栏中选择“工具”（在“运行”旁边）。接下来，选择“参考”。向下浏览直到看到“ MICROSOFT OUTLOOK 16.0对象库”并进行检查。希望这是有道理的。

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

从Outlook 2007中获取所有分发列表

1 个答案: