VBScript; List Exchange Mailbox DACL / ACE / ACL

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