Const ForReading = 1, ForWriting = 2, ForAppending = 8

Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 118009
Const ROAccessMask = 1179817

On Error Resume Next

strComputer = "."
sOutputFile = InputBox("Please Enter the Outputfile", "Output File")

sParentFolder = InputBox("Please Enter folder to gather information on", "Parent Folder")


Set fso = CreateObject("Scripting.FileSystemObject")
Set fsOut = fso.OpenTextFile(sOutputFile, ForAppending, True)
fsOut.Writeline "Folder,User Name,Permission"
fsOut.Close

Call OutputFolderInfo(sParentFolder, sOutputFile)

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\cimv2")
Set aSubfolder_1 = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & _
    sParentFolder & "'}" _
        & "WHERE AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")

For Each sSubfolder1 In aSubfolder_1
    Call OutputFolderInfo(sSubfolder1.Name, sOutputFile)
    Set aSubfolder_2 = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & _
        sSubfolder1.Name & "'}" _
    & "WHERE AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")
    For Each sSubfolder2 In aSubfolder_2
        Call OutputFolderInfo(sSubfolder2.Name, sOutputFile)
        Set aSubfolder_3 = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & _
            sSubfolder2.Name & "'}" _
        & "WHERE AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")
    Next
Next


Public Sub OutputFolderInfo(FolderName , sOutfile)

Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 1180095
Const ROAccessMask = 1179817
Const ForReading = 1, ForWriting = 2, ForAppending = 8
strComputer = "."

'Build the path to the folder because it requites 2 backslashes
folderpath = Replace(FolderName, "\", "\\")

objectpath = "winmgmts:Win32_LogicalFileSecuritySetting.path='" & folderpath & "'"

'Get the security set for the object
Set wmiFileSecSetting = GetObject(objectpath)

'verify that the get was successful
RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
'If Err <> 0 Then
    'MsgBox ("GetSecurityDescriptor failed" & vbCrLf & Err.Number & vbCrLf & Err.Description)
    'End
'End If


Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\cimv2")
Set colFolders = objWMIService.ExecQuery("SELECT * FROM Win32_Directory WHERE Name ='" & _
    folderpath & "'")
For Each objFolder In colFolders
    
    ' Retrieve the DACL array of Win32_ACE objects.
    DACL = wmiSecurityDescriptor.DACL

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsOut = fso.OpenTextFile(sOutfile, ForAppending, True)
    

    For Each wmiAce In DACL
    ' Get Win32_Trustee object from ACE
        Set Trustee = wmiAce.Trustee
        fsOut.Write objFolder.Name & "," & Trustee.Domain & "\" & Trustee.Name & ","
        FoundAccessMask = False
        CustomAccessMask = Flase
        While Not FoundAccessMask And Not CustomAccessMask
            If wmiAce.AccessMask = FullAccessMask Then
                AccessType = "Full Control"
                FoundAccessMask = True
            End If
            If wmiAce.AccessMask = ModifyAccessMask Then
                AccessType = "Modify"
                FoundAccessMask = True
            End If
            If wmiAce.AccessMask = WriteAccessMask Then
                AccessType = "Read/Write Control"
                FoundAccessMask = True
            End If
            If wmiAce.AccessMask = ROAccessMask Then
                AccessType = "Read Only"
                FoundAccessMask = True
            Else
                CustomAccessMask = True
            End If
        Wend
      
        If FoundAccessMask Then
            fsOut.Writeline AccessType
        Else
            fsOut.Writeline "Custom"
        End If
       
    Next

    Set fsOut = Nothing
    Set fso = Nothing

Next

Set fsOut = Nothing
Set fso = Nothing

end sub