What the script does:

1. create a “disconnected recordset” (for the sorting stuff)
2. get all users from active directory with an ADO query
3. remove undesired results (if instr…)
4. add the rest to the disconnected recordset
5. sort the recordset
6. output to the screen

Follow the next steps to run the script (no admin rights needed):

• copy and paste the script below into the editor (you can use the icons in the upper rights corner of the code)
• save the script (for example c:\temp\usersinou.vbs)
• open a command prompt
• go to “c:\temp”
• give “cscript usersinou.vbs” (without quotes) and enter

The script:

' Name : usersinou.vbs
' Description : script to enumerate all Active Directory users sorted by OU
' Author : dirk adamsky - deludi bv
' Version : 1.0
' Date : 05-10-2011

Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "Name", 200, 255
DataList.Fields.Append "OU", 200, 255
DataList.Open

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = ""
strFilter = "(&(objectCategory=person)(objectClass=user))"
strAttributes = "name,distinguishedname"

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

Do Until adoRecordset.EOF
	If Instr(adoRecordset.Fields("distinguishedname").Value,"OU=") > 1 Then
		DataList.AddNew
		DataList("Name") = adoRecordset.Fields("name").Value
		DataList("OU") = Mid(adoRecordset.Fields("distinguishedname").Value, Instr(adoRecordset.Fields("distinguishedname").Value,"OU="))
		Datalist.Update
	End If
	adoRecordset.MoveNext
Loop

adoRecordset.Close
adoConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

DataList.Sort = "OU DESC"
DataList.MoveFirst

Do Until DataList.EOF
     Wscript.Echo DataList.Fields.Item("OU") & " ; " & DataList.Fields.Item("Name")
     DataList.MoveNext
Loop

Datalist.Close
Set DataList = Nothing

When you have a modified version or problems/questions that you want to share please post it at the comments below.

Happy scripting.

Dirk Adamsky

Follow the next steps to run the script (no admin rights needed):

• find the distinguished names of the nested groups (adsiedit.msc)
• put them in an Excel sheet in the first column ans save the sheet as c:\temp\groups.xls
• open your favorite text editor
• copy and paste the script below into the editor (you can use the icons in the upper rights corner of the code)
• save the script (for example c:\temp\enumeratenestedgroupsfromexcelsheet.vbs)
• open a command prompt
• go to “c:\temp”
• give “cscript enumeratenestedgroupsfromexcelsheet.vbs” (without quotes) and enter

The script:

' Name : enumeratenestedgroupsfromexcelsheet.vbs
' Description : script to enumerate nested Active Directory groups from an Excel sheet
' Author : dirk adamsky - deludi bv
' Version : 1.0
' Date : 04-10-2011

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\temp\groups.xls")
intRow = 2
Do Until objExcel.Cells(intRow,1).Value = ""
strGroupDN = objExcel.Cells(intRow, 1).Value
If strGroupDN <> "" Then
wscript.echo strGroupDN
EnumNestedgroup "LDAP://" & strGroupDN
End If
intRow = intRow + 1
Loop
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing

Function EnumNestedgroup(strGroupDN)
Set objGroup = GetObject(strGroupDN)
For Each objMember in objGroup.Members
If (LCase(objMember.Class) = "group") Then
EnumNestedgroup objMember.AdsPath
Else
Wscript.Echo objGroup.cn & " ; " & objMember.DisplayName & " ; " & objMember.Mail
End If
Next
Set objGroup = Nothing
End Function

When you have a modified version or problems/questions that you want to share please post it at the comments below.

Happy scripting.

Dirk Adamsky

Dave asked me for a script to enumerate all AD users, their home directories and the size of them.
I already had the script to do that for roaming profiles.
This script is a modified version.

Follow the next steps to run the script (admin rights needed for access to the home directories):

* open your favorite text editor
* copy and paste the script into the editor
* save the script (for example c:\temp\homedirectorysize.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript homedirectorysize.vbs” (without quotes) and enter

The script:

' Name : homedirectorysize.vbs
' Description : script to enumerate the home directories and their sizes of all users in Active Directory
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 12-07-2011
' Level : intermediate

arrAttributes = Array("homeDirectory","displayname","mail") 

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"
Set objRootDSE = Nothing

strFilter = "(&(objectCategory=person)(objectClass=user)(homeDirectory=*))"
strAttributes = Join(arrAttributes,",")
Wscript.Echo Join(arrAttributes,";") & " ; home directory size in MB"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
	On Error Resume Next
	strTempOutput = ""
	For i = 0 To Ubound(arrAttributes)
		strTempOutput =  strTempOutput & " ; " & adoRecordset.Fields(arrAttributes(i)).Value
		strOutput = Mid(Ltrim(strTempOutput),3)
	Next
	Wscript.Echo strOutput & " ; " & Foldersize (adoRecordset.Fields(arrAttributes(0)).Value) & " MB"
	adoRecordset.MoveNext
Loop
adoRecordset.Close
adoConnection.Close
Set adoRecordset = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

Function Foldersize(strPath)
	On Error Resume Next
	Set objFSO = CreateObject("scripting.filesystemobject")
	Set objFld = objFSO.GetFolder(strPath)
	Foldersize = Round(objFld.Size/1048576,2)
	Set objFld = Nothing
	Set objFSO = Nothing
End Function

When you have problems/questions please post a reply. Also can alo give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

Windows XP – “c:\documents and settings”

Windows 7 – “c:\users”

The script has to do:

• get all Windows XP and Windows 7 clients from Active Directory
• check if they are online
• get the local profiles and their sizes from each machine
• write the values to a central logfile

Follow the next steps to run the script (local admin rights needed for access to the target pc’s):

* open your favorite text editor
* copy and paste the script into the editor
* change the logfile location in line 73 (now c:\temp)
* save the script (for example c:\temp\localprofiles.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript localprofiles.vbs” (without quotes) and enter

The script:

' Name : localprofiles.vbs
' Description : script to enumerate the local profile size of all computers and users in Active Directory
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 28-06-2011

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"
strFilter = "(&(objectCategory=computer)(|(operatingSystem=Windows XP Professional)(operatingSystem=Windows 7*)))"
strAttributes = "name, operatingSystem"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

Do Until adoRecordset.EOF
	strHostname = adoRecordset.Fields("name").Value
	If CheckStatus(strHostname) = True Then
		If Instr(adoRecordset.Fields("operatingSystem").Value, "XP") > 0 Then
			strLocalProfilePath = "\Documents and Settings\"
		ElseIf Instr(adoRecordset.Fields("operatingSystem").Value, "7") > 0 Then
			strLocalProfilePath = "\users\"
		End If
		GetLocalProfileSize strHostname, "\\" & strHostname & "\c$" & strLocalProfilePath
	End If
	adoRecordset.MoveNext
Loop

adoRecordset.Close
adoConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

Function CheckStatus(strAddress)
	Dim objPing, objRetStatus
	Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
      ("select * from Win32_PingStatus where address = '" & strAddress & "'")
	For Each objRetStatus In objPing
        If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
			CheckStatus = False
        Else
			CheckStatus = True
        End If
    Next
	Set objPing = Nothing
End Function

Function GetLocalProfileSize(strTargetMachine, strFolder)
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFolder = objFSO.GetFolder(strFolder)
	For Each SubFolder in objFolder.SubFolders
		Logprint strTargetMachine & " ; " & SubFolder.Name & " ; " & SubFolder.Path & " ; " & Round(SubFolder.Size/1048576,2) & " MB"
	Next
	Set objFolder = Nothing
	Set objFSO = Nothing
End Function

Function LogPrint(Message)
Const ForAppending = 8
strDate = Replace(Date,"/","-")
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = ObjFSO.OpenTextFile("c:\temp\" & strDate & "-localprofiles.csv", ForAppending, True)
    objTextFile.WriteLine Message
    objTextFile.Close
Set objTextFile = Nothing
Set ObjFSO = Nothing
End Function

When you have problems/questions please post a reply. Also can also give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

His question was a script that enumerates all groups and their members from a given OU.
I already had a script that enumerates the members of an OU.
I also had a script that enumerates the members of a nested group (uses recursion).
The 2 scripts combined are the solution for Tyrone.

Follow the next steps to run the script (no admin rights needed):

* open your favorite text editor
* copy and paste the script into the editor
* change the OU distinguished name (in line 7) into your OU distinguished name
* save the script (for example c:\temp\EnumerateGroupsInOu.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript EnumerateGroupsInOu.vbs” (without quotes) and enter

You can also dump the output to a file:

* give “cscript EnumerateGroupsInOu.vbs > EnumerateGroupsInOu.txt” (without quotes) and enter

To get that file into Excel:

* open Excel
* go to Menu=>Open File
* change file type to “all”
* chose EnumerateGroupsInOu.txt
* chose “;” as separator character

The script:

' Name : EnumerateGroupsInOu.vbs
' Description : script to enumerate all groups and their members from a specific Active Directory OU
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 01-06-2011

Set objOU = GetObject("LDAP://OU=test,DC=test,DC=org")
	For Each objMember in objOU
		If (LCase(objMember.Class) = "group") Then
			EnumNestedgroup objMember.AdsPath
		End If
	Next
Set objOU = Nothing

Function EnumNestedgroup(strGroupDN)
	Set objGroup = GetObject(strGroupDN)
	For Each objMember in objGroup.Members
		If (LCase(objMember.Class) = "group") Then
			wscript.echo objMember.AdsPath
			EnumNestedgroup objMember.AdsPath
		Else
			Wscript.Echo objGroup.Name & " ; " & objMember.DisplayName & " ; " & objMember.Mail &_
			" ; " & objMember.Department &  " ; " &	objMember.Company & " ;  " & objMember.Title
		End If
	Next
	Set objGroup = Nothing
End Function

When you have problems/questions with the script please post a reply.

Happy scripting.

Best regards,

Dirk Adamsky

The printers of each user are saved in the user profile
(in the ntuser.dat file to be precisely).
The easiest way to get a list of printers per user is to add a small script to the logon script (can also be done with a group policy).
The script below is such a script.
It is very compact and can be run under the users credentials.
The script does a WMI query (the Win32_Printer Class) for the printers and writes the output to a file.
Unfortunately we cannot use the same file for all users because of potential “file locking” problems.
This can be adressed by using a database but that is beyond the scope of this article.

Follow the next steps to run the script (no admin rights needed):

* open your favorite text editor
* copy and paste the script into the editor
* change the UNC path (“\srvXXXlogfiles”) in the LogToFile function on line 19 to your UNC path
* save the script (for example c:tempprinters.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript printers.vbs” (without quotes) and enter

To run the script as a logon script you can copy the script to the netlogon share or another user accessible location.

The script:

' Name : printers.vbs
' Description : script to enumerate the printers of Active Directory users and write the results to a file
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 27-05-2011

Set objNetwork = CreateObject("Wscript.Network")
Set objWMIService = GetObject("winmgmts:\.rootcimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
For Each objPrinter in colPrinters
    LogToFile(objNetwork.UserDomain & "" & objNetwork.UserName & " ; " & objPrinter.Name)
Next
Set colPrinters = Nothing
Set objWMIService = Nothing
Set objNetwork = Nothing 

Function LogToFile(Message)
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = ObjFSO.OpenTextFile("\srvXXXlogfiles" & objNetwork.UserName & Date & ".txt",8,True)
objTextFile.WriteLine Message
objTextFile.Close
Set objTextFile = Nothing
Set ObjFSO = Nothing
End Function

When you have problems/questions with the script please post a reply.

Happy scripting.

Best regards,

Dirk Adamsky

My first attempt was to use the VB Arraylist object (.Net needed on the script machine).
Here’s an Arraylist example by Rob van der Woude.
The problem with the Arraylist object is that it is not made for sorting multi dimensional arrays.
I can do some tricks by concatenating all values to a superstring.
The problem is that sorting an Arraylist with superstrings will be next to impossible.

Luckily I found a better solution by using a disconnected recordset
(= a recordset without database connection).
One thing to check is to use the right datatype for each variable.
I declared the “size” variable as a “double precision floating point”.
The other 2 were delared as “null-terminated character strings”.
With the disconnected recordset you can do a lot of funky stuff like sorting, filtering and so on.
I will certainly use the disconnected recordset object in new scripts.

I have tested the script in a large environment (~ 8500 mailboxes).
It worked flawless (okay I had to test and modify it for half an hour or so).

What the script does:

• get all exchange servers from your AD domain
• make a wmi connection to each server and create a list of the mailboxes and their size
• put all values in a disconnected recordset, sort and output to the screen

The script is tested in a win2003/exchange2003 environment.

Follow the next steps to run the script (admin rights needed):

• copy and paste the script in your favorite text editor
• save the script (for example c:tempsortedlistofallmailboxes.vbs)
• open a command prompt
• go to “c:temp”
• give “cscript sortedlistofallmailboxes.vbs” (without quotes) and enter

The script:

' Name : sortedlistofallmailboxes.vbs
' Description : script to enumerate all mailboxes and their size in your AD domain
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 17-05-2011
' Level: intermediate

Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "Servername", 200, 255
DataList.Fields.Append "DisplayName", 200, 255
DataList.Fields.Append "Size", 5
DataList.Open

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://" & objRootDSE.Get("configurationnamingcontext") & ">"
strFilter = "(objectCategory=msExchExchangeServer)"
strAttributes = "name"

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 3
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

Do Until adoRecordset.EOF
 Set objWMIExchange = GetObject("winmgmts:{impersonationLevel=impersonate}!//"&_
 adoRecordset.Fields("name").Value & "/root/MicrosoftExchangeV2")
 Set colExchangeMailboxes = objWMIExchange.InstancesOf("Exchange_Mailbox")
 For Each objExchangeMailbox in colExchangeMailboxes
 If Left(objExchangeMailbox.StorageGroupName, 5) <> "Recov" Then
 DataList.AddNew
 DataList("Servername") = adoRecordset.Fields("name").Value
 DataList("DisplayName") = objExchangeMailbox.MailboxDisplayName
 DataList("Size") = Round(objExchangeMailbox.Size/1024,0)
 Datalist.Update
 End If
 Next
 Set colExchange_Mailboxes = Nothing
 Set objWMIExchange = Nothing
 adoRecordset.MoveNext
Loop

adoRecordset.Close
adoConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

DataList.Sort = "Size DESC"
DataList.MoveFirst

Do Until DataList.EOF
 Wscript.Echo DataList.Fields.Item("Size") & " MB ; " & DataList.Fields.Item("DisplayName") & " ; " &_
 DataList.Fields.Item("Servername")
 DataList.MoveNext
Loop

Datalist.Close
Set DataList = Nothing

When you have problems/questions please post a reply or give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

This script enumerates all user accounts in Active Directory en checks if the “Password Never Expires”
marker is set.
The check is no simple 1 or 0 but a bitwise comparison of the userAccountControl Value with
ADS_UF_DONT_EXPIRE_PASSWD (or &H10000 in vbs hex code).
userAccountControl Value for accounts with “Password Never Expires” not enabled -
Decimal: 512 <=> Binary: 1000000000.
ADS_UF_DONT_EXPIRE_PASSWD – Hexadecimal (vbs):  &H10000 <=>
Decimal: 65536 <=> Binary: 10000000000000000.

In the example above the binary comparison gives a zero as result, all non-zero results implicate that the value is enabled.

Follow the next steps to run the script (no admin rights needed):

* open your favorite text editor
* copy and paste the script into the editor
* save the script (for example c:\temp\PasswordNeverExpires.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript PasswordNeverExpires.vbs” (without quotes) and enter

The script:

' Name : PasswordNeverExpires.vbs
' Description : script to enumerate all accounts with Password Never Expires enabled in Active Directory
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 11-05-2011
' Level: Intermediate

Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"
strFilter = "(&(objectCategory=person)(objectClass=user))"
strAttributes = "cn,mail,distinguishedName"

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

Do Until adoRecordset.EOF
	On Error Resume Next
	Set objUser = GetObject("LDAP://" & adoRecordset.Fields("distinguishedName").Value)
	If (objUser.userAccountControl And ADS_UF_DONT_EXPIRE_PASSWD) <> 0 Then
		Wscript.echo adoRecordset.Fields("cn").Value & " ; " & adoRecordset.Fields("mail").Value
	End If
	Set objUser = Nothing
    adoRecordset.MoveNext
Loop

adoRecordset.Close
adoConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

When you have problems/questions with the script please post a reply.

Happy scripting.

Best regards,

Dirk Adamsky

What the script does:

• make a wmi connection to a given exchange server and create a list of the mailboxes and their size

The script is tested in an win2003/exchange2003 environment.

Follow the next steps to run the script (admin rights needed):

• copy and paste the script in your favorite text editor
• replace the string ‘srv001′ with the name of your exchange server
• save the script (for example c:tempmailboxes.vbs)
• open a command prompt
• go to “c:temp”
• give “cscript mailboxes.vbs” (without quotes) and enter

When you want the output in a file please give this command:

“cscript mailboxes.vbs > mailboxes.txt” (again without the quotes)

The script:

' Name : mailboxes.vbs
' Description : script to enumerate all mailboxes on a given Exchange server
' Author : dirk adamsky - deludi bv
' Version : 1.10 (changed/corrected based on input by Mike)
' Date : 23-03-2011
' Level: intermediate

strServer = "srv001"
Const MinimalSize = 2048 'size in MB
Set objWMIExchange = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/MicrosoftExchangeV2")
Set colExchangeMailboxes = objWMIExchange.InstancesOf("Exchange_Mailbox")
For Each objExchangeMailbox in colExchangeMailboxes
    If (Left(objExchangeMailbox.StorageGroupName, 5) <> "Recov") And (Round(objExchangeMailbox.Size/1024,0) > MinimalSize) Then
		Wscript.Echo objExchangeMailbox.MailboxDisplayName & " ; " &_
			Round(objExchangeMailbox.Size/1024,0) & " MB"
	End If
Next
Set colExchange_Mailboxes = Nothing
Set objWMIExchange = Nothing

When you have problems/questions please post a reply or give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

Follow the next steps to run the script (admin rights needed for the WMI connection):

• copy and paste the script in your favorite text editor
• save the script (for example c:\temp\uncacl2.vbs)
• open a command prompt
• go to “c:\temp”
• give “cscript uncacl2.vbs” (without quotes) and enter

The script:

' Name : uncacl2.vbs
' Description : script to enumerate the ntfs rights of a given UNC path and a given level of subfolders
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 22-10-2010

strUNCPathName = InputBox("please supply the UNC path to the shared folder")
strSubfolderLevel = InputBox("please supply the subfolder depth (1,2,etc.)")
arrUNC = split(strUNCPathName,"\")
If Ubound(arrUNC) > 3 Then
strRightPartOfPath = Mid(strUNCPathName,(Instr(strUNCPathName,arrUNC(4)) -1))
End If
Set objWMI = GetObject("winmgmts:\\" & arrUNC(2) & "\root\CIMV2")
Set objFileShare = objWMI.Get("Win32_Share.Name=""" & arrUNC(3) & """")
If Right(arrUNC(3),1) = "$" And Len(arrUNC(3)) = 2 Then
strPath = objFileShare.Path & Mid(strRightPartOfPath,2)
Else
strPath = objFileShare.Path & strRightPartOfPath
End If
ShowACL strPath
ViewSubFolders strPath, strSubfolderLevel
Set objFileShare = Nothing
Set objWMI = Nothing

Function ViewSubfolders(strFolder, strMaxlevel)
Set colSubfolders = objWMI.ExecQuery("Associators Of {Win32_Directory.Name='" & strFolder & "'} " &_
"Where AssocClass = Win32_Subdirectory ResultRole = PartComponent")
If strMaxlevel >= 1 Then
    For Each SubFolder in colSubfolders
        wscript.echo SubFolder.Name
        ShowACL SubFolder.Name
        ViewSubFolders SubFolder.Name, (strMaxlevel - 1)
    Next
End If
Set colSubfolders = Nothing
End Function

Function ShowACL(strDir)
Set objFolderSecuritySettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")
objFolderSecuritySettings.GetSecurityDescriptor objSD
For Each objAce in objSD.DACL
    Select Case objAce.AccessMask
        Case 1179817
            strRights = "read-only"
        Case 2032127
            strRights = "full-control"
        Case 1245631
            strRights = "change"
    End Select
Wscript.Echo strUNCPathName & " ; " & strDir & " ; " & objAce.Trustee.Domain & " ; " & objAce.Trustee.Name & " ; " & strRights
Next
Set objSD = Nothing
Set objFolderSecuritySettings = Nothing
End Function

When you have problems/questions please post a reply or give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV