The below VBScript will return all user mailboxes on your environment and display the DACL for the mailbox. This helps to easily identify custom ACEs during an Exchange migration enabling you to pre-configure permissions in your target environment. The script is useful in identifying groups of users that work together and thus need access to each others mailboxes.
The script will create an Excel file, although I have stopped the script form closing the Excel file as this will cause issues in the event of you running Office versons earlier than 2003.
On Error Resume Next
sXLS = “C:\mbx-access-rights-export.xls” ‘excel file must be created before script is ran
Set objRootDSE = GetObject(“LDAP://rootDSE”)
strDNSDomain = objRootDSE.Get(“defaultNamingContext”)
‘Start the ADO connection
Set objCommand = CreateObject(“ADODB.Command”)
Set objConnection = CreateObject(“ADODB.Connection”)
objConnection.Provider = “ADsDSOObject”
objConnection.Open “Active Directory Provider”
objCommand.ActiveConnection = objConnection
‘Set the ADO connection query strings
StartNode = strDNSDomain
SearchScope = “subtree”
FilterString = “(&(objectCategory=person)(objectClass=user)” _
& “(description=*)” _
& “(mail=*))” _
‘& “(!(userAccountControl:1.2.840.113556.1.4.803:=2)))”
Attributes = “adspath”
‘Create the LDAP-Query
LDAPQuery = “;” & FilterString & “;” _
& Attributes & “;” & SearchScope
objCommand.CommandText = LDAPQuery
objCommand.Properties(“Page Size”) = 100
objCommand.Properties(“Timeout”) = 30
objCommand.Properties(“Cache Results”) = False
Set objRecordSet = objCommand.Execute
Set objExcel = CreateObject(“Excel.Application”)
objExcel.Application.DisplayAlerts = False
objExcel.Visible = True
‘Set objWorkbook = objExcel.Workbooks.Open(sXLS)
objExcel.Workbooks.Add
objExcel.Cells(1,1).Value = “Logon Name”
objExcel.Cells(1,2).Value = “Display Name”
objExcel.Cells(1,3).Value = “Email Address”
objExcel.Cells(1,4).Value = “Mailbox Rights”
xRow = 1
yColumn = 1
Do Until yColumn = 5
objExcel.Cells(xRow,yColumn).Font.Bold = True
objExcel.Cells(xRow,yColumn).Font.Size = 11
objExcel.Cells(xRow,yColumn).Interior.ColorIndex = 11
objExcel.Cells(xRow,yColumn).Interior.Pattern = 1
objExcel.Cells(xRow,yColumn).Font.ColorIndex = 2
objExcel.Cells(xRow,yColumn).Borders.LineStyle = 1
objExcel.Cells(xRow,yColumn).WrapText = True
yColumn = yColumn + 1
Loop
x = 2
y = 1
If NOT objRecordSet.eof Then
objRecordSet.MoveFirst
While Not objRecordset.EOF
Set objUser = GetObject(objRecordSet.Fields(“AdsPath”).Value)
y1 = y
objExcel.Cells(x,y1).Value = objUser.sAMAccountName
y1 = y1 + 1
objExcel.Cells(x,y1).Value = objUser.displayName
y1 = y1 + 1
objExcel.Cells(x,y1).Value = objUser.mail
y1 = y1 + 1
Set oSecurityDescriptor = objuser.Get(“msExchMailboxSecurityDescriptor”)
Set dacl = oSecurityDescriptor.DiscretionaryAcl
Set ace = CreateObject(“AccessControlEntry”)
For Each ace In dacl
mystring = ace.Trustee
If (ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED) Then
x = x + 1
objExcel.Cells(x,y1).Value = mystring & ” has access”
ElseIf (ace.AceType = ADS_ACETYPE_ACCESS_DENIED) Then
x = x + 1
objExcel.Cells(x,y1).Value = mystring & ” is denied access”
End If
Next
x = x + 1 ‘go to the next Row
objRecordSet.MoveNext
Wend
End If
objExcel.Columns(“A:D”).Select
objExcel.Selection.HorizontalAlignment = 3 ‘center all data
objExcel.Selection.Borders.LineStyle = 1 ‘apply borders
objExcel.Columns(“A:AH”).EntireColumn.AutoFit ‘autofit all columns
appVerInt = split(objExcel.Version, “.”)(0)
If appVerInt-Excel2007 >=0 Then
objExcel.ActiveWorkbook.SaveAs(sXLS), 56 ‘office 2007
Else
objExcel.ActiveWorkbook.SaveAs(sXLS), 43 ‘office 2003
End If
‘objExcel.Quit
set objExcel = Nothing
Set objUser = Nothing
msgbox “Done!”
WScript.Quit