How to fix share permissions script

Hi,

What is your OS against which you are trying to run the script? Are the shares local or remote?

I can do it in powershell if that helps.

Regards,
Navdeep [v-2nas]

Hi, this should be your code with the required fixes.

Regards,

Rob.

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)

RecurseFolder sParentFolder

Sub RecurseFolder(sFolderPath)
	Set fso = CreateObject("Scripting.FileSystemObject")
	Call OutputFolderInfo(sFolderPath, sOutputFile)
	For Each objSubFolder In fso.GetFolder(sFolderPath).SubFolders
		RecurseFolder objSubFolder.Path
	Next
End Sub

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

Select allOpen in new window

great thank you.  i get an error on line 44 char 1

i am running it on a remote machine.  the shares are on a remote machine.  the OS is server 2008

if that helps

Hi, it had errors when using it against a remote computer.  I have tested this now, and fixed some things, so it should work.

Regards,

Rob.

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

Const FullAccessMask = 2032127, ModifyAccessMask = 1245631, WriteAccessMask = 118009
Const ROAccessMask = 1179817
Set objNetwork = CreateObject("WScript.Network")

'On Error Resume Next

strComputer = Trim(InputBox("Please Enter the computer name to get permissions from:", "Computer Name", objNetwork.ComputerName))
sOutputFile = Trim(InputBox("Please Enter the Outputfile", "Output File"))
sParentFolder = Trim(InputBox("Please Enter folder to gather information on", "Parent Folder"))

If strComputer = "." Then strComputer = objNetwork.ComputerName

If strComputer = "" Or sOutputFile = "" Or sParentFolder = "" Then
	WScript.Echo "One or more required strings are missing.  Please enter the correct details."
	WScript.Quit
End If

sUNCFolder = "\\" & strComputer & "\" & Replace(sParentFolder, ":", "$")

Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FolderExists(sUNCFolder) = True Then

	Set fsOut = fso.OpenTextFile(sOutputFile, ForAppending, True)
	fsOut.Writeline "Folder,User Name,Permission"
	fsOut.Close
	
	Call OutputFolderInfo(sUNCFolder, sOutputFile)
	
	RecurseFolder sUNCFolder
Else
	WScript.Echo sParentFolder & " cannot be found on " & strComputer
End If

Sub RecurseFolder(sFolderPath)
	Set fso = CreateObject("Scripting.FileSystemObject")
	Call OutputFolderInfo(sFolderPath, sOutputFile)
	For Each objSubFolder In fso.GetFolder(sFolderPath).SubFolders
		RecurseFolder objSubFolder.Path
	Next
End Sub

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 = Mid(FolderName, Len("\\" & strComputer & "\") + 1)
folderpath = Left(folderpath, InStr(folderpath, "$") - 1) & ":" & Mid(folderpath, InStr(folderpath, "$") + 1)

WScript.Echo folderpath

folderpath = Replace(folderpath, "\", "\\")

objectpath = "winmgmts:\\" & strComputer & "\root\cimv2: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

Select allOpen in new window

it runs complete now but.  it gives me a message at the end of running stating that the share i entered could not be found?

i know that the share is there because i have 500 people accessing it.  i get the same message when i try different shares.

i think i am typing something in wrong.

for the first popup box i enter the name of the server
for the second popup box i name the output file
for the third popup box i enter in the share i want permissions from right? or do i need to put in \\server\share? or just the share name?

either way i type in the share name it says it could not find it?  what am i doing wrong?

You need to enter the physical file path as it is located on the remote server.

For example, if you have
\\server\finance

but the Finance folder, as it is on the server, is located in D:\Departments\Finance, then when prompt for the folder, enter
D:\Departments\Finance

Regards,

Rob.