troubleshooting Question

vba code to read ntfs permissions on the root path only

Avatar of benevolentanarchist
benevolentanarchist asked on
ProgrammingMicrosoft Development
3 Comments1 Solution2732 ViewsLast Modified:
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
David Johnson, CD
The More I know, the more I don't know
Join our community to see this answer!
Unlock 1 Answer and 3 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 3 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros