Avatar of benevolentanarchist
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("Wscript.shell")
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.Workbooks.Add
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
	
Next
 
'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
		
		Next
 
	Else

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

Open in new window

ProgrammingMicrosoft Development

Avatar of undefined
Last Comment
benevolentanarchist

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
David Johnson, CD

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
benevolentanarchist

ASKER
thank you.
benevolentanarchist

ASKER
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.
Your help has saved me hundreds of hours of internet surfing.
fblack61