I'm looking to use a spreadsheet I've created to generate folders and sub-folders based on what is in each column.

The first column is the top level, the second column the next level down (sub-folder) and so on.

 A B C D
1 TOP FOLDER 1 Sub Folder 1.1 Sub Folder 1.2 Sub Folder 1.3
2 TOP FOLDER 2 Sub Folder 2.1 Sub Folder 2.2 Sub Folder 2.3
3 TOP FOLDER 3 Sub Folder 3.1 Sub Folder 3.2 Sub Folder 3.3

I've tried another program already and it made the folders but put them all in one folder! I need it with sub-folders, but I think an issue might be separating the folders, here's an example:

I'm thinking it may be problematic to separate the sub-folders into their parent folders because they are in the same columns...

3 Answers

This creates a folder structure with VBA. Short and beautiful.

Sub CreateFolderStructure() Dim objRow as Range, objCell as Range, strFolders as String For Each objRow In ActiveSheet.UsedRange.Rows strFolders = "C:\myRootFolder" For Each objCell In objRow.Cells strFolders = strFolders & "\" & objCell Next Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34)) Next
End Sub

^{No error handling!}

What it does

1. Loop through every used row of your active Excel sheet
2. Set the root folder in which our new folders should be created. Must be done in every loop
3. Loop through every used cell in the current row
4. Concatenate the root folder with a backslash and the new sub folder.
   Do this for every sub folder in that row until we get something like
   "C:\myRootFolder\TOP FOLDER 1\SUB FOLDER 1.1\SUB FOLDER 1.2\SUB FOLDER 1.3"
5. Now comes the magic. We do not use VBA's mkdir function.
   Instead we use Shell(cmd /c md) which can make several folders with one command. It also produces no error if a folder already exists. Such a beautiful command

Some notes

• Avoid these characters in folder names: © ® " - & ' ^ ( ) @
• Empty Excel cells are no problem. The MD command can handle strings like C:\root\\subfolder with two consecutive backslashes
• Spaces in folder names are no problem since we wrap the complete structure with two quotation marks (chr(34))

1

Sub MkDirs() Const RootPath = "C:\your\path" Dim rng As Range Set rng = Selection For Each rw In rng.Rows ChDir RootPath For Each cl In rw.Cells If cl <> "" Then MkDir cl ChDir cl End If Next Next
End Sub

Here is a better answer that allows you to choose a root file instead of defining it in the code:

Sub FolderCreator() Dim objRow As Range, objCell As Range, strFolders As String, rootFolder As String With Application.FileDialog(msoFileDialogFolderPicker) ' show the file picker dialog box If .Show <> 0 Then rootFolder = .SelectedItems(1) End If End With For Each objRow In ActiveSheet.UsedRange.Rows strFolders = rootFolder For Each objCell In objRow.Cells strFolders = strFolders & "\" & objCell Next Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34)) Next
End Sub

Your Answer

Sign up or log in

Sign up using Google Sign up using Facebook Sign up using Email and Password Submit

Post as a guest

Post Your Answer Discard

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