如何提取" Mail Universal Distribution Group"来自Exchange使用VBA?

时间:2018-02-23 10:21:37

标签: excel vba excel-vba outlook-vba exchange-server-2010

我可以使用以下代码轻松地从Exchange获取所有普通的基于用户的邮箱:

Public Sub GetOutlookExchangeUserInformation()

    ' Variable declarations.
    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 the Outlook object variables
    Set olApp = CreateObject("Outlook.Application")
    Set olNameSpace = olApp.GetNamespace("MAPI")
    Set olAddrList = olNameSpace.AddressLists("Global Address List")

    ' Create a new worksheet.
    Set sh = ThisWorkbook.Worksheets.Add

    ' Add some headers for our data.
    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"
        .Cells(1, 7) = "EMAIL"
    End With

    ' Start the counter in the second row.
    lCnt = 2

    ' Iterate through the address entires in the address list.
    For Each olAddrEntry In olAddrList.AddressEntries

        Set olExchgnUser = olAddrEntry.GetExchangeUser

        ' Turn off error handling, because occasionally you hit a
        ' record with nothing in it and it throws an error.
        On Error Resume Next

        ' Write the Outlook data to the worksheet.
        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
            sh.Cells(lCnt, 7) = .PrimarySmtpAddress
        End With


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

        If Err.Number = 0 Then lCnt = lCnt + 1
        ' Clear any error.
        Err.Clear
        ' Reset the error handling.
        On Error GoTo 0

    Next olAddrEntry

    ' Clear the status bar.
    Application.StatusBar = ""

    ' Prompt the user that we've finished.
    MsgBox "Extract done."

End Sub

(参考以上工作所需的Microsoft Outlook)

我需要检索我在Exchange中可以看到的所有Mail Universal Distribution Group项。它们列在Recipient Configuration > Distribution Group下,我真正需要的只是名称+电子邮件地址。

我尝试将对olExchgnUser的引用更改为以下内容:

Dim olExchgnDL      As ExchangeDistributionList
Set olExchgnDL = olAddrEntry.GetExchangeDistributionList

这只返回列表中的最后一个通讯组。有没有办法以类似的方式返回所有用户邮箱?

0 个答案:

没有答案