6
\$\begingroup\$

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.

\$\endgroup\$
  • \$\begingroup\$ I'd put my commands into a file and then get the shell to run the commands in my file. \$\endgroup\$ – Freeflow Nov 6 '19 at 16:37
  • \$\begingroup\$ 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. \$\endgroup\$ – 5202456 Nov 6 '19 at 16:44
  • \$\begingroup\$ 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. \$\endgroup\$ – pacmaninbw Nov 6 '19 at 16:48
  • 1
    \$\begingroup\$ @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' \$\endgroup\$ – 5202456 Nov 6 '19 at 20:05
5
\$\begingroup\$

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
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.