我可以使用以下代码轻松地从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
这只返回列表中的最后一个通讯组。有没有办法以类似的方式返回所有用户邮箱?