Changing the ACL on a folder through Wscript.Shell within VBA

Question

I have working VBA code in excel that changes a network folders permissions.

The code uses Wscript.Shell to run icacls commands but there are multiple instances of this command and each time it runs, it opens up a new shell window.

It would be interesting to see if there is a way of making the code more efficient by opening a single shell instance then go on to run each of the icacls commands.

Private Sub TestingPermissions()
Dim FSO
Dim MyFolder
Dim objShell
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = FSO.GetFolder(Worksheets("Config").Range("D4").Value & ActiveSheet.Range("C21").Value)
Set objShell = CreateObject("Wscript.Shell")
' Take ownership and modify permission of folder
objShell.Run ("takeown /f " & """" & MyFolder & "\My Music""" & " /r /d y")
objShell.Run ("icacls " & """" & MyFolder & "\My Music""" & " /setowner mydomain\admin")
objShell.Run ("icacls " & """" & MyFolder & "\My Music""" & " /grant mydomain\StudentExam101:(OI)(CI)F /T")
objShell.Run ("icacls " & """" & MyFolder & "\My Music""" & " /grant mydomain\DAdmins:(OI)(CI)F /T")
objShell.Run ("icacls " & """" & MyFolder & "\My Music""" & " /grant mydomain\admin:(OI)(CI)F /T")
objShell.Run ("icacls " & """" & MyFolder & "\My Music""" & " /grant SYSTEM:(OI)(CI)F /T")
objShell.Run ("icacls " & """" & MyFolder & "\My Music""" & " /grant CREATOR OWNER:(OI)(CI)F /T")
End Sub

I thought I had found a part solution by combining the icalcs permissions all into one command but further testing and I realised it had not worked, but I will investigate this further anyway.

• Freeflow: I'd put my commands into a file and then get the shell to run the commands in my file.
• 5202456: I was thinking about having the vba create the file with the commands and run it from there, but I decided to go this way as it seems a slightly cleaner solution as their are no external files to deal with. The code shown is only a small part of what the vba script will do and it will be run many times with information updated pulled into the spread sheet from multiple sources.
• pacmaninbw: Just a warning, this phrase What I would like the code to be able to do ... might make the question off-topic as it indicates either the code is not working as expected or this is a feature request, which we can't answer.
• 5202456: @pacmaninbw thanks for the tip, I'm more used to asking questions in stackoverflow so I will make a note of that. Now re-worded as: 'It would be interesting to see if there is a way of making the code more efficient'

Answer 1

CodeReview

Why use the Scripting.FileSystemObject? MyFolder is just returning the folder name

MyFolder = Worksheets("Config").Range("D4").Value & ActiveSheet.Range("C21").Value

I would also write a function to return the folder path and a second function to create the icacls commands.

Fun Part: My Own Solution

The class below will create a self-deleting batch file. Running it in silent mode will hide the command window. The advantage of using a batch file is that you can add a pause that will allow you to inspect the results of your commands.

Note: pause will have no effect in silent mode and the files do not delete themselves immediately but they will automatically delete after a short time.

Command Window

---

Class: BatchFile

Attribute VB_Name = "BatchFile"
Option Explicit
Public FileText As String
Private Const DeleteCommand As String = "DEL ""%~f0"""
Public Sub AppendLine(Text As String)
 If Len(FileText) > 0 Then FileText = FileText & vbNewLine
 FileText = FileText & Text
End Sub
Public Sub AddICacls(ByVal FolderName As String, ByVal Parameters As String)
 AppendLine "icacls " & Chr(34) & FolderName & Chr(34) & Parameters
End Sub
Public Sub Execute(SilentMode As Boolean)
 Dim FilePath As String
 FilePath = getTempBatchFileName
 CreateFile FilePath
 Dim oShell As Object
 Set oShell = CreateObject("WScript.Shell")
 If SilentMode Then
 oShell.Run Chr(34) & FilePath & Chr(34), 0
 Else
 oShell.Run Chr(34) & FilePath & Chr(34)
 End If
 Set oShell = Nothing
End Sub
Private Sub CreateFile(FilePath As String)
 Dim Text As String
 Text = FileText & vbNewLine & DeleteCommand
 Dim FileNumber As Long
 FileNumber = FreeFile
 Open FilePath For Output As FileNumber
 Print #FileNumber, Text
 Close FileNumber
 Debug.Print Text
End Sub
Private Function getTempBatchFileName() As String
 Dim n As Long
 Dim FilePath As String
 Do
 n = n + 1
 FilePath = Environ("Temp") & "\" & n & ".bat"
 Loop While Len(Dir(FilePath)) > 0
 getTempBatchFileName = FilePath
End Function

---

Usage

Sub RunICalcs()
 Const DebugMode As Boolean = True
 Dim Batch As New BatchFile
 Dim FolderName As String
 FolderName = getFolderPath
 Batch.AddICacls FolderName, " /r /d y"
 Batch.AddICacls FolderName, " /setowner mydomain\admin"
 Batch.AddICacls FolderName, " /grant mydomain\StudentExam101:(OI)(CI)F /T"
 Batch.AddICacls FolderName, " /grant mydomain\DAdmins:(OI)(CI)F /T"
 Batch.AddICacls FolderName, " /grant mydomain\admin:(OI)(CI)F /T"
 Batch.AddICacls FolderName, " /grant SYSTEM:(OI)(CI)F /T"
 Batch.AddICacls FolderName, " /grant CREATOR OWNER:(OI)(CI)F /T"
 If DebugMode Then
 Batch.AppendLine "pause"
 Batch.Execute False
 Else
 Batch.AppendLine "pause"
 Batch.Execute True
 End If
End Sub
Function getFolderPath() As String
 getFolderPath = Worksheets("Config").Range("D4").Value & ActiveSheet.Range("C21").Value
End Function