Create folder structure from an Excel list of names, with permissions

Question

Could anyone help please?

I regularly need to create a folder structure on a drive, which would have a folder per user, with only RW access to that user (+ admin), plus a set of group folders, for shared work, with RW access to the members of that group.

I would like to organise this using Excel and VBS. The following spreadsheet structure:

Resulting in a file structure as below on whichever drive is specified:

Answer 1

Hi Alan

I partially reproduced your scenario

Please, find in the link below a file with the answer to your question.

https://1drv.ms/x/s!AjGRD1TlwpAGlifDRTRzpONv51ir?e=9MmJOj

Notes:

Minor changes.

1-Group List was moved to allow to input more Team members therefore create more folders.

2-Cell B4 to Input Directory Path whichever drive you specified.

3-The file has 2 macro codes,

a)- Macro "Make_Folders" will do exactly as you requested.

b)- Macro  "Make_Folders_And_SubFolders" will create the Group Folders and then create the User ID SubFolders inside the corresponding Group Folder

Macro 2 RESULTS

The codes

************************************************************************************

Sub Make_Folders()

Dim GPath, GName, UName As String

Dim UserID, Groups, G, U As Range

Dim Gcounter, Ucounter As Integer

''' The path where the folders will be created

GPath = Sheets("Sheet1").Range("B4").Value

On Error GoTo Finish

'''' If Path is empty or incomplete

If Len(GPath) = 0 Or Right(GPath, 1) <> "" Then

Finish:

MsgBox "Please, check if:" & vbNewLine _

& "1- Folder Path is empty." & vbNewLine _

& "2- or "" \ "" is missing at the end of the path." & vbNewLine _

& "3- or Path does not exist.", vbCritical

        Exit Sub

End If

'''' Groups List Range

Set Groups = Sheets("Sheet1").Range(Cells(8, "F"), Cells(Rows.Count, "F").End(xlUp))

'''' User ID List Range

Set UserID = Sheets("Sheet1").Range(Cells(8, "C"), Cells(Rows.Count, "C").End(xlUp))

''''''''''''''''''''''''''  Create Groups Folders    '''''''''''''''''''''''''''''''''''''''''''''''''''

For Each G In Groups

        GName = Trim(G.Value) & "_Group"

        ''' To check if the Folder exist (if so skip it)

        If Len(Dir(GPath & GName, vbDirectory)) > 0 Then

                GoTo Nxt1

        Else

                MkDir GPath & GName

                Gcounter = Gcounter + 1

        End If

Nxt1:

Next G

''''''''''''''''''''''''''  Create User ID Folders    '''''''''''''''''''''''''''''''''''''''''''''''''''

For Each U In UserID

        UName = Trim(U.Value)

        ''' To check if the Folder exist (if so skip it)

        If Len(Dir(GPath & UName, vbDirectory)) > 0 Then

                GoTo Nxt2

        Else

                MkDir GPath & UName

                Ucounter = Ucounter + 1

        End If

Nxt2:

Next U

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

If Gcounter + Ucounter = 0 Then

        MsgBox "All Folders exist, " & vbNewLine & "No folder to be created"

Else

        MsgBox "Job Done !!" & vbNewLine _

        & "Group Folders created: = " & Gcounter & vbNewLine _

        & "User ID Folders created: = " & Ucounter, _

        Title:="Foders Created Count"

End If

End Sub

Sub Make_Folders_And_SubFolders()

Dim GPath, GName, UName, UGroup As String

Dim UserID, Groups, G, U As Range

Dim Gcounter, Ucounter As Integer

''' The path where the folders will be created

GPath = Sheets("Sheet1").Range("B4").Value

On Error GoTo Finish

'''' If Path is empty or incomplete

If Len(GPath) = 0 Or Right(GPath, 1) <> "" Then

Finish:

MsgBox "Please, check if:" & vbNewLine _

& "1- Folder Path is empty." & vbNewLine _

& "2- or "" \ "" is missing at the end of the path." & vbNewLine _

& "3- or Path does not exist.", vbCritical

        Exit Sub

End If

'''' Groups List Range

Set Groups = Sheets("Sheet1").Range(Cells(8, "F"), Cells(Rows.Count, "F").End(xlUp))

'''' User ID List Range

Set UserID = Sheets("Sheet1").Range(Cells(8, "C"), Cells(Rows.Count, "C").End(xlUp))

''''''''''''''''''''''''''  Create Groups Folders    '''''''''''''''''''''''''''''''''''''''''''''''''''

For Each G In Groups

        GName = Trim(G.Value) & "_Group"

        ''' To check if the Folder exist (if so skip it)

        If Len(Dir(GPath & GName, vbDirectory)) > 0 Then

                GoTo Nxt1

        Else

                MkDir GPath & GName

                Gcounter = Gcounter + 1

        End If

Nxt1:

Next G

''''''''''''''''''''''''''  Create User ID SubFolders on its corresponding Group Folder  '''''''''''''''''''''''''''''''''''''''''''''''''''

For Each U In UserID

        UName = Trim(U.Value) ''User name ID

        UGroup = Trim(U.Offset(0, 1).Value) & "_Group"  '''User Name's Group

        ''' To check if the Folder exist (if so skip it)

        If Len(Dir(GPath & UGroup & "" & UName, vbDirectory)) > 0 Then

                GoTo Nxt2

        Else

                MkDir GPath & UGroup & "" & UName

                Ucounter = Ucounter + 1

        End If

Nxt2:

Next U

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

If Gcounter + Ucounter = 0 Then

        MsgBox "All Folders exist, " & vbNewLine & "No folder to be created"

Else

        MsgBox "Job Done !!" & vbNewLine _

        & "Group Folders created: = " & Gcounter & vbNewLine _

        & "User ID Folders created: = " & Ucounter, _

        Title:="Foders Created Count"

End If

End Sub

**************************************************************************************

Do let me know if you need more help

If the answer helps you, please, consider to mark this thread as answered, It would help others in the community with similar question or problems. Thank you in advance

Regards

Jeovany

Answer 2

Jeovany,

Thats exactlywhat I wanted. Works a treat.

Many thanks

Answer 3

Macro 2 is a better way of dealing with my requirements.

Thanks,

Alan