Vbs that List folder & subfolder Permission

Here is a modified script I have used to get a list of shares on a fileserver and their ACLs.  You may be able to extract from it some code that you might find useful.

'########################################################################################
'#											#
'#	Name:		Shares.vbs							#
'#	Description:	This script retrieve a list of shares and output the ACLs 	#
'#			to textfile.							#
'#											#
'#	Software:	ShowACLs.Exe							#
'#											#
'########################################################################################
Option Explicit
 
DIM strComputer
DIM WMI
DIM strLine
DIM strDotted
DIM colShares
DIM Share
DIM strShare
DIM strPath
DIM strACLs
DIM strHeader
DIM ListACL
DIM ListShare
DIM strLog
 
strComputer = "."
 
strLine = "__________________________________________________________________________"
 
strDotted = "--------------------------------------------------------------------------"
 
ListShare = "List of File Shares and their corresponding ACLs" & vbcrlf & _
	strLine & vbcrlf & vbcrlf & vbtab & "Share Name" & vbtab & _
	vbtab & vbtab & vbtab & "Share Path" & vbcrlf & strLine & vbcrlf
 
strLog = vbcrlf & strLine
 
 
Set WMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colShares = WMI.ExecQuery("Select * from Win32_Share")
 
 
For Each Share in colShares
	strShare = Share.Name
	strPath = Share.Path
 
	strHeader = vbcrlf & "ACLs for " & strShare & vbcrlf & vbcrlf & "Users" & vbtab & _
		vbtab & vbtab & vbtab & vbtab & vbtab & "Access" & vbcrlf & strDotted & vbcrlf
 
	If right(strPath, 1) = "\" then
		strPath = strPath & " "
	End If
 
	If strShare <> "print$" and Share.Type = "0" then
 
		strShare = trim(strShare)
		Do until len(strShare) => 35
			strShare = strShare & " "
		Loop
 
		ListShare = ListShare & vbtab & strShare & vbtab & trim(strPath) & vbcrlf
 
		strACLs = func_GetACLs(strPath)
 
		If inStr( strACLs, "error: ") = FALSE then
			ListACL = func_ModACLs(strACLs)
		ElseIf instr (strACLs, "volume") then
			ListACL = "Not an NTFS volume, could not retrive ACLs" & vbcrlf
		Else
			ListACL = "An Error occured and the ACLs could not be retrieved" & vbcrlf
		End If
		
		strLog =  strLog & vbcrlf & strHeader & ListACL & strDotted & vbcrlf
			
	End If
Next
 
strLog = ListShare & strLog
 
func_Docs(strLog)
 
set strComputer = Nothing
set strLine = Nothing
set strDotted = Nothing
set WMI = Nothing
set colShares = Nothing
set Share = Nothing
set strShare = Nothing
set strPath = Nothing
set strHeader = Nothing
set ListACL = Nothing
set strLog = Nothing
 
 
Function func_GetACLs(strPath)
 
	DIM WShell
	DIM objExec
	DIM strResults
 
	Set WShell = CreateObject("Wscript.Shell")
	Set objExec = WShell.Exec("showacls " & """" & strPath & """")
	strResults = LCase(objExec.StdOut.ReadAll)
 
	func_GetACLs = strResults
 
	set objExec = Nothing
	set strResults = Nothing
	set WSHell = Nothing
 
End Function
 
 
Function func_ModACLs(strACLs)
 
	DIM Cnt
	DIM strResult
	DIM x
	DIM arrACL
	DIM strACL
 
	strACLs = split(strACLs, vbcrlf)
	
	For Cnt = 1 to uBound(strACLs)
		If strACLs(Cnt) <> "" then
			arrACL = Right(strACLs(Cnt), len(strACLs(Cnt)) - 2)
			arrACL = split(arrACL, "  ")
 
			For x = 0 to uBound(arrACL)
				If arrACL(x) <> "" then
					
					strACL = arrACL(x)
 
					strACL = trim(strACL)
 
					Do until len(strACL) => 45
						strACL = strACL & " "
					Loop
					strResult = strResult & strACL & vbtab
 
				End If
			Next
 
		End If
		If strACLs(Cnt) <> "" then
			strResult = strResult & vbcrlf
		End If
	Next
 
	func_ModACLs = strResult
 
	set Cnt = Nothing
	set strResult = Nothing
	set x = Nothing
	set arrACL = Nothing
	set strACL = Nothing
	
End Function
 
'================================
'       Document Shares
'================================
Function func_Docs(strLog)
 
	DIM FSO
	DIM strFolder
	DIM CLog
	DIM ShareFile
	DIM LogFile
 
	Set FSO = CreateObject("Scripting.FileSystemObject")
 
	strFolder = "C:\ScriptLogs" 
 
	If FSO.FolderExists(strFolder) = false then
		CLog = FSO.CreateFolder(strFolder)
	End If
 
	ShareFile =  strFolder & "\Shares.txt"
 
	Set LogFile = FSO.OpenTextFile(ShareFile, 2, True)
		Logfile.Write strLog
	LogFile.Close
 
	set FSO = Nothing
	set strFolder = Nothing
	set CLog = Nothing
	set ShareFile = Nothing
	set LogFile = Nothing
 
End Function

Select allOpen in new window

thanks but my main problem and i dont have any idea how to do that its only to get the acl only on 3 folder depth.

ex: c:\folder1\folder2\folder3\folder4
and get the ACL on folder 1, folder 2, folder 3 and discard further foler.

Any idea?

You can use the subfolders property of the folder you are currently in.

As far as just going from Folder, to SubFolder, to SubFolder.  I think the only way to do that is to have a counter set at 1 before you call the sub and include it as one of the parameters of the sub.  Then before you call the sub from within the sub increment it by 1 and then do an If cnt < 3 then do the sub.

Sub ShowFolderList(folderspec)
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.SubFolders
    For Each f1 in fc
        s = s & f1.name 
        s = s &  vbCrLf
    Next
    MsgBox s
End Sub

Select allOpen in new window

I just did it but my script got and error because it search too much folder.