Submitted By: Alan Mosley

Reports which users have access to Microsoft Exchange mailboxes.

Visual Basic
Edit|Remove
‘Who Has Access - By Alan Mosley, ThatsIT Solutions Australia

'Writes report to text file, showing who has access to Exchange users mailboxes 
'Must be run on email Server

Const DOMAIN = "IT"
Const EMAIL_SERVER = "HANK"
Const LDAP_DOMAIN = "LDAP://dc=ThatsIT,dc=local"

Dim objUser
Dim oSecurityDescriptor 
Dim dacl 
Dim ace

Dim fso:Set fso = CreateObject("Scripting.FileSystemObject")
set tf = fso.CreateTextFile("WhoHasAccess.txt",true)
getUsers(DOMAIN)
tf.WriteLine "Who Has Access - By Alan Mosley, ThatsIT Solutions Australia"
tf.close

Sub getUsers( strDomain )
            Set objComputer = GetObject("WinNT://" & strDomain )
            objComputer.Filter = Array( "User" )
            For Each objUser In objComputer
                        writeACEs         objUser.Name
            Next
End Sub

sub writeACEs(userName)
            On Error Resume Next
            Const ADS_SCOPE_SUBTREE = 10
            Set objConnection = CreateObject("ADODB.Connection")
            Set objCommand = CreateObject("ADODB.Command")
            objConnection.Provider = "ADsDSOObject"
            objConnection.Open "Active Directory Provider"
            Set objCommand.ActiveConnection = objConnection
            objCommand.Properties("Page Size") = 1000
            objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
            objCommand.CommandText = _
                "SELECT distinguishedName FROM '"& LDAP_DOMAIN &"' WHERE objectCategory='user' " & _
                    "AND sAMAccountName='"& userName &"'"
            Set objRecordSet = objCommand.Execute
            dim ans
            objRecordSet.MoveFirst
            Do Until objRecordSet.EOF
                ans = objRecordSet.Fields("distinguishedName").Value
                objRecordSet.MoveNext
            Loop
            set objUser = GetObject("LDAP://"& EMAIL_SERVER &"/"& ans)
            Dim fullName:fullName =  Trim( objUser.FullName)
            if objUser.HomeMDB <> "" then
                        Set oSecurityDescriptor = objUser.MailboxRights
                        Set dacl = oSecurityDescriptor.DiscretionaryAcl
                        tf.WriteLine objUser.FullName 
                        tf.WriteLine spaceIt("Trustee",30) & spaceIt("AccessMask",11) & spaceIt("ACEType",11) & _
                            spaceIt("ACEFlags",11) & spaceIt("Flags",11) 
                        For Each ace In dacl
                                    tf.WriteLine spaceIt(ace.Trustee,30) & spaceIt(ace.AccessMask,11) & _
                                    spaceIt(ace.AceType,11) & spaceIt(ace.AceFlags,11) & spaceIt(ace.Flags,11)
                        Next
                        tf.WriteLine 
                        tf.WriteLine 
            end if
end sub

function spaceIt(val,spaceCount)
            dim aLine , dLen
            aLine = val
            dLen = len(aLine)
            dLen = spaceCount - dLen
            for i = 1 to dLen
                        aLine = aLine & " "
            next
            spaceIt = aLine
end function