Link to home
Start Free TrialLog in
Avatar of benevolentanarchist

asked on

vba code to read ntfs permissions on the root path only

I need VBA code that will read/retrieve NTFS permissions on a specified folder. I found this great VBS code that accepts a path and retrieves permissions from all subfolders. (it does not return the permissions for the specified path, only subfolders).

I am only concerned with retrieving permissions from the specified path and not concerned with the subfolders.

Unfortunately I am not a programmer so I have no idea how to modify this code to fit my needs. Can anyone help? I actually need the code to run in VBA (Excel).

Thanks in advance to anyone who can assist.
'Create instance of Shell Object:
Set objShell = CreateObject("")
Set voice = CreateObject("SAPI.Spvoice")
Text = "Please wait. Enumerating Discretionary Access Control List for the folders"
'Creating Excel Instance:
Set excelinstance = CreateObject("Excel.application")
excelinstance.Visible = True
'Creating Columns:
excelinstance.Cells(1, 1).Value = "Folders"
excelinstance.Cells(1, 2).Value = "Domain"
excelinstance.Cells(1, 3).Value = "Users/Groups"
'Starting from Second Row:
m = 2
'Setting properties for columns:
Set Range = excelinstance.Range("A1", "C1")
Range.Font.Size = 12
Range.Font.Bold = True
Range.Interior.ColorIndex = 6
Range.Font.Name = "Times New Roman"
Range.ColumnWidth = 20
'WMI Code:
strcomputer = "."
'Specify the path for the share:
strpathname = "c:\temp"
voice.Speak Text
objShell.Popup "Please wait....Enumerating Discretionary Access Control List for the folders", 5
'Calling Swbemservices Object:
Set x = GetObject("winmgmts:\\" & strcomputer & "\root\cimv2")
Set Folders = x.ExecQuery("Associators of {Win32_Directory.Name='" & strpathname & "'} " _
                          & "Where AssocClass = Win32_Subdirectory " _
                          & "ResultRole = PartComponent")
For Each subfolder In Folders
	Getsubfolders strpathname
'Sub Function for Recursive Enumeration of Folders:
Sub Getsubfolders(strpathname)
Set folders1 = x.ExecQuery ("Associators of {Win32_Directory.Name='" & strpathname & "'} " _
                            & "Where AssocClass = Win32_Subdirectory " _
                            & "ResultRole = PartComponent")
For Each subfolders1 In folders1
	strpathname = subfolders1.Name
	excelinstance.Cells(m, 1) = strpathname
	excelinstance.Cells(m, 1).ColumnWidth = 70
	excelinstance.Cells(m, 1).Font.Name = "Times New Roman"
	'Enumerating DACL's for each folder:
	Set objFolderSecuritySettings = _
	x.Get("Win32_LogicalFileSecuritySetting='" & strpathname & "'")
	returncode = objFolderSecuritySettings.GetSecurityDescriptor(SD)
	If returncode = 0 Then
		colaccess = SD.DACL
		For Each objaccess In colaccess
			excelinstance.Cells(m, 2) = objaccess.trustee.domain
			excelinstance.Cells(m, 2).ColumnWidth = 40
			excelinstance.Cells(m, 2).Font.Name = "Times New Roman"
			excelinstance.Cells(m, 3) = objaccess.trustee.Name
			excelinstance.Cells(m, 3).ColumnWidth = 50
			excelinstance.Cells(m, 3).Font.Name = "Times New Roman"
			m = m + 1
			Getsubfolders strpathname

		excelinstance.Cells(m, 2).Value = "DACL could not be retrieved"
		excelinstance.Cells(m, 3).Value = "DACL could not be retrieved"
	End If
End Sub

Open in new window

Avatar of David Johnson, CD
David Johnson, CD
Flag of Canada image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of benevolentanarchist


thank you.
it appears that this method only works with local files/folders, i.e. I can't get ntfs acls on a \\servername\d$\share\name. for my needs, it seems like this code is a dead, but I thought I'd as if anyone has any ideas.

To recap; I'm trying to retrieve ntfs permissions on a share folder(s) and output to an excel spreadsheet. this is in preparation for migration.