Csdrhrt

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...

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:myRootFolderTOP FOLDER 1SUB FOLDER 1.1SUB FOLDER 1.2SUB 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))

Sub MkDirs()



    Const RootPath = "C:yourpath"

    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