Thursday, October 1, 2009

Folder structure creator - Excel VBS

If you need to create a lot of folders and subfolders, Excel_2007.jpgwith some specific structure, it can be usefull if you can use the power of Excel to make up your folder names and structure. All kind of easy and quick formulas can be used, and once the strucuture is set up, you can easily create the empty folder structure with just one click by using this little VBS macro. The base folder used will depend on the location of the Excel file, so make sure it's saved or copied in the correct folder.
Sub CreateFolderStructure()
'Create folder for all vlues in current sheet
'folders will be created in folder where the excel file was saved
'folders will be created from first row, first column, until empty row is found
'Example expected cell structure: (data starting in current sheet, column A, row 1)
'folder1 subfolder1 subsubfolder1
'folder2
'folder3 subfolder3
'...
'this will result in:
'\folder1\subfolder1\subsubfolder1
'\folder2
'\folder3\subfolder3
'...
Set fs = CreateObject("Scripting.FileSystemObject")
For iRow = 1 To 65000
pathToCreate = ActiveWorkbook.Path
For iColumn = 1 To 65000
currValue = Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, iColumn).Value
If (currValue = "") Then
Exit For
Else
pathToCreate = pathToCreate & "\" & CStr(currValue)
'MsgBox (pathToCreate)
folderToCreate = pathToCreate
If Not (fs.FolderExists(folderToCreate)) Then
fs.CreateFolder (folderToCreate)
End If
End If
Next
Next
End Sub


The Excel sheet with the macro can be downloaded here. Before running the macro make sure the rows and columns of the active sheet are filled in correctly. Next simply run the macro by using the button. foldercreatorexcel1foldercreatorexcel2 foldercreatorexcel3foldercreatorexcel4


If you created to many empty folders by accident, you can easily remove them again using this little tool: Remove Empty Directories


Update 13/11/2009: Modified the Excel VBS script to let you navigate to the desired base folder upon launching the macro, so the Excel file may now be saved at any location, the base folder will have to be specified upon launching the macro.


Update 21/04/2012: Someone commented the VBS code is not working correctly when using some special characters. This is because some characters are not supported by Windows to be used in a file or folder name.


FolderChar


I updated the VBS code in the Excel sheet to make sure these special characters are removed before trying to create the folders.


The Excel sheet is updated, also an Excel template is available.


An example with special characters and the resulting folders created:


FolderSpecialCharsExample


The new VBS code used is:


Sub CreateFolderStructure()
'Create folder for all vlues in current sheet
'folders will be created in folder where the excel file was saved
'folders will be created from first row, first column, until empty row is found
'Example expected cell structure: (data starting in current sheet, column A, row 1)
'folder1    subfolder1  subsubfolder1
'folder2
'folder3    subfolder3
'           subfolder4
'...
'this will result in:
'\folder1\subfolder1\subsubfolder1
'\folder2
'\folder3\subfolder3
'\folder3\subfolder4
'...
    baseFolder = BrowseForFolder
    If (baseFolder = False) Then
        Exit Sub
    End If
    Set fs = CreateObject("Scripting.FileSystemObject")
    For iRow = 2 To 6500
        pathToCreate = baseFolder
        leafFound = False
        For iColumn = 1 To 6500
            currValue = Trim(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, iColumn).Value, ":", ""), "*", ""), "?", ""), Chr(34), ""), "<", ""), ">", ""), "|", ""))
            If (currValue = "" And leafFound) Then
                Exit For
            ElseIf (currValue = "") Then
                parentFolder = FindParentFolder(iRow, iColumn)
                parentFolder = Replace(Replace(Replace(Replace(Replace(Replace(Replace(parentFolder, ":", ""), "*", ""), "?", ""), Chr(34), ""), "<", ""), ">", ""), "|", "")
                If (parentFolder = False) Then
                    Exit For
                Else
                    pathToCreate = pathToCreate & "\" & parentFolder
                    If Not (fs.FolderExists(pathToCreate)) Then
                        CreateDirs (pathToCreate)
                    End If
                End If
            Else
                leafFound = True
                pathToCreate = pathToCreate & "\" & currValue
                If Not (fs.FolderExists(pathToCreate)) Then
                    CreateDirs (pathToCreate)
                End If
            End If
        Next
        If (leafFound = False) Then
            Exit For
        End If
    Next
End Sub

Function FindParentFolder(row, column)
    For iRow = row To 0 Step -1
        currValue = Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, column).Value
        If (currValue <> "") Then
            FindParentFolder = CStr(currValue)
            Exit Function
        ElseIf (column <> 1) Then
            leftValue = Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, column - 1).Value
            If (leftValue <> "") Then
                FindParentFolder = False
                Exit Function
            End If
        End If
    Next
End Function


Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

Sub CreateDirs(MyDirName)
' This subroutine creates multiple folders like CMD.EXE's internal MD command.
' By default VBScript can only create one level of folders at a time (blows
' up otherwise!).
'
' Argument:
' MyDirName   [string]   folder(s) to be created, single or
'                        multi level, absolute or relative,
'                        "d:\folder\subfolder" format or UNC
'
' Written by Todd Reeves
' Modified by Rob van der Woude
' http://www.robvanderwoude.com

    Dim arrDirs, i, idxFirst, objFSO, strDir, strDirBuild

    ' Create a file system object
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    ' Convert relative to absolute path
    strDir = objFSO.GetAbsolutePathName(MyDirName)

    ' Split a multi level path in its "components"
    arrDirs = Split(strDir, "\")

    ' Check if the absolute path is UNC or not
    If Left(strDir, 2) = "\\" Then
        strDirBuild = "\\" & arrDirs(2) & "\" & arrDirs(3) & "\"
        idxFirst = 4
    Else
        strDirBuild = arrDirs(0) & "\"
        idxFirst = 1
    End If

    ' Check each (sub)folder and create it if it doesn't exist
    For i = idxFirst To UBound(arrDirs)
        strDirBuild = objFSO.BuildPath(strDirBuild, arrDirs(i))
        If Not objFSO.FolderExists(strDirBuild) Then
            objFSO.CreateFolder strDirBuild
        End If
    Next

    ' Release the file system object
    Set objFSO = Nothing
End Sub


11/10/2012: I updated the VBS code in the Excel sheet to make sure these special characters are removed before trying to create the folders. Extra input information and validation is added to make sure invalid characters can not be used. The Excel sheet is updated


08/08/2013: Updated sheets, added a trim to remove spaces at begin and end of cell value, since this could result in macro exception (see comments)


17/02/2014: I’ve extended this workbook with a new sheet in which the nested folder structure of the filesystem can be imported. Each folder name will be stored in a separate cell respecting the nested structure


The new VBS code is:


  
Sub ImportFolderStructure()
'Import folder structure starting from selected base folder
'each subfolder will be stored in a separete cell
'eg:
'Folder 1|Subfolder1|SubSubfolder1
'Folder 2|Subfolder2
'Folder 3|Subfolder3|SubSubfolder3
'...
    Application.ScreenUpdating = False
    baseFolder = BrowseForFolder
    If (baseFolder = False) Then
        Exit Sub
    End If
    Application.StatusBar = "Folder structure below " & baseFolder & " will be stored in the sheet " & ActiveCell.Worksheet.Name
    StoreSubFolder baseFolder, 1, 0
    Application.StatusBar = "Folder structure below " & baseFolder & " has been stored in the sheet " & ActiveCell.Worksheet.Name
    Range("A2").Select
    Application.ScreenUpdating = True
End Sub

Sub StoreSubFolder(baseFolderObj, ByRef iRow, ByVal iColumn)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set folderBase = fs.GetFolder(baseFolderObj)
    Set folderBaseSubs = folderBase.SubFolders
    iRow = iRow + 1
    iColumn = iColumn + 1
    For Each subFolder In folderBaseSubs
        Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, iColumn).Value = subFolder.Name
        StoreSubFolder subFolder, iRow, iColumn
    Next
End Sub

Sub ClearImportData()
    Application.ScreenUpdating = False
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    Range("A2").Select
    Application.ScreenUpdating = True
End Sub

Sub CreateFolderStructure()
'Create folder for all vlues in current sheet
'folders will be created in folder where the excel file was saved
'folders will be created from first row, first column, until empty row is found
'Example expected cell structure: (data starting in current sheet, column A, row 1)
'folder1    subfolder1  subsubfolder1
'folder2
'folder3    subfolder3
'           subfolder4
'...
'this will result in:
'<currentpath>\folder1\subfolder1\subsubfolder1
'<currentpath>\folder2
'<currentpath>\folder3\subfolder3
'<currentpath>\folder3\subfolder4
'...
    baseFolder = BrowseForFolder
    If (baseFolder = False) Then
        Exit Sub
    End If
    Set fs = CreateObject("Scripting.FileSystemObject")
    For iRow = 2 To 6500
        pathToCreate = baseFolder
        leafFound = False
        For iColumn = 1 To 6500
            currValue = Trim(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, iColumn).Value, ":", "-"), "*", "-"), "?", "-"), Chr(34), "-"), "<", "-"), ">", "-"), "|", "-"), "/", "-"), "\", "-"))
            Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, iColumn).Value = currValue
            If (currValue = "" And leafFound) Then
                Exit For
            ElseIf (currValue = "") Then
                parentFolder = FindParentFolder(iRow, iColumn)
                If (parentFolder = False) Then
                    Exit For
                Else
                    pathToCreate = pathToCreate & "\" & parentFolder
                    If Not (fs.FolderExists(pathToCreate)) Then
                        CreateDirs (pathToCreate)
                    End If
                End If
            Else
                leafFound = True
                pathToCreate = pathToCreate & "\" & currValue
                If Not (fs.FolderExists(pathToCreate)) Then
                    CreateDirs (pathToCreate)
                End If
            End If
        Next
        If (leafFound = False) Then
            Exit For
        End If
    Next
End Sub

Function FindParentFolder(row, column)
    For iRow = row To 0 Step -1
        currValue = Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, column).Value
        If (currValue <> "") Then
            FindParentFolder = CStr(currValue)
            Exit Function
        ElseIf (column <> 1) Then
            leftValue = Worksheets(ActiveCell.Worksheet.Name).Cells(iRow, column - 1).Value
            If (leftValue <> "") Then
                FindParentFolder = False
                Exit Function
            End If
        End If
    Next
End Function

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

Sub CreateDirs(MyDirName)
' This subroutine creates multiple folders like CMD.EXE's internal MD command.
' By default VBScript can only create one level of folders at a time (blows
' up otherwise!).
'
' Argument:
' MyDirName   [string]   folder(s) to be created, single or
'                        multi level, absolute or relative,
'                        "d:\folder\subfolder" format or UNC
'
' Written by Todd Reeves
' Modified by Rob van der Woude
' http://www.robvanderwoude.com

    Dim arrDirs, i, idxFirst, objFSO, strDir, strDirBuild
    ' Create a file system object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' Convert relative to absolute path
    strDir = objFSO.GetAbsolutePathName(MyDirName)
    ' Split a multi level path in its "components"
    arrDirs = Split(strDir, "\")
    ' Check if the absolute path is UNC or not
    If Left(strDir, 2) = "\\" Then
        strDirBuild = "\\" & arrDirs(2) & "\" & arrDirs(3) & "\"
        idxFirst = 4
    Else
        strDirBuild = arrDirs(0) & "\"
        idxFirst = 1
    End If

    ' Check each (sub)folder and create it if it doesn't exist
    For i = idxFirst To UBound(arrDirs)
        strDirBuild = objFSO.BuildPath(strDirBuild, arrDirs(i))
        If Not objFSO.FolderExists(strDirBuild) Then
            objFSO.CreateFolder strDirBuild
        End If
    Next

    ' Release the file system object
    Set objFSO = Nothing
End Sub


The Excel file can be downloaded as XLS (template for easy reuse). My Excel sheet with combined macro’s has been updated as well, see this blog post.










Update 27/05/2014: cleanup of the cell types (some cell were saved as type ‘Scientific’ resulting in some strange representation after import of folders named with numbers, Thanks to Jean for reporting)

47 comments:

  1. Congratulations and thank you for you xls vbs, its reallly what i was looking for end theres nothing better in net, al least i have not found anything better. its fast, easy and very flexible.

    i use it by my work. Health and peace forwever!

    ReplyDelete
  2. The link to the file is dead, please reupload.

    ReplyDelete
  3. great macro! See what I created using your macro, an SEC filing and MindMeister:
    http://www.mindmeister.com/105299836/unitedhealth-subsidiaries

    ReplyDelete
  4. vb error: "Path not found"

    sample input:
    00 Intro 01 Welcome
    00 Intro 02 Text here
    00 Intro 03 More text here

    should create 1 folder with 3 sub-folders

    ReplyDelete
  5. tested it and seems to work OK, also tested on windows network share and worked as well. I used this sheet to test: http://dl.dropbox.com/u/2328438/CreateFolderStructure%20Excel%20VBS%20-%20test%2000%20intro.xls

    could you give more details on your case?

    ReplyDelete
  6. It is realy good which i want.
    Thanks a lot booss.
    The sheet is really reduce your effort by unexpected way.

    ReplyDelete
  7. thanks for you feedback! i'm glad it could be of any use to other people... ;)

    ReplyDelete
  8. The code seems to break when running into characters such as = ":" or "/". Is there a fix for this?

    ReplyDelete
  9. My naming convention needs to include those characters in creation I see they are excluded for some reason. Anyway to change the code to accept them?

    ReplyDelete
  10. thanks for your feedback!
    some special characters are not supported in file/folder names...i updated the code to remove these characters when creating the folder name.
    '/' and '\' are now supported, but these will result in a subfolder to be created. so normally you shouldn't need these since you can as well use another cell to create the desired subfolder.
    I updated the post for new files and code.
    Regards,
    myT

    ReplyDelete
    Replies
    1. Just want to say this is a great tool saved me and my boss a ton of work!!

      I ended up just removing the special characters from the file and renaming them after we created it. The reason why we needed the files named like that because it was passed to us this way we had no control on naming convention. Once again great tool and thank you for having this available.

      Delete
  11. thx :)
    just out of curiosity, how do you change them manually afterwards? It's an OS limitation, not a limitation of this tool... Or are you using the sheet on a Linux file system?

    A good overview of different filename reservered characters and limitations: http://en.wikipedia.org/wiki/Filename#Comparison%5Fof%5Ffile%5Fname%5Flimitations

    ReplyDelete
    Replies
    1. Sorry let me rephrase it I removed the names and replaced it with a X noting that I had to replace the name later. I ran the earlier version and this caused it to run properly. That's when I went back and realized the folder name limitations. Contacted them and worked around it. Call me ignorant but I never knew about the naming limits on folders.Once again thank you for your help.

      Delete
  12. Hi there .. this is an awesome tool however I am encountering an error while trying to create multiple level folders---

    my scenario

    Column1 Column 2 Column 3 Column 4
    Row 1 Folder Name 1 Folder Name 2

    Row 2 Folder Name 3 Folder Name 4
    Folder Name 5

    The error says "Path not found"

    ReplyDelete
  13. Could you send the excell to myTselection (at) gmail.com? I'll take a look at it...

    Regard,
    myT

    ReplyDelete
  14. I am also getting the "Path not found" error.

    ReplyDelete
  15. Could you send the excell to myTselection (at) gmail.com? I'll take a look at it...

    Regard,
    myT

    ReplyDelete
  16. Don't use slashes in the names of folders, it's not supported by Windows. I'll make a new version of the sheet to make sure the illegal special characters can not be used anymore. If you encounter issues with the sheet, just look at the special characters for now ;)

    ReplyDelete
  17. 11/10/2012: I updated the VBS code in the Excel sheet to make sure these special characters are removed before trying to create the folders. Extra input information and validation is added to make sure invalid characters can not be used. The Excel sheet is updated, also the Excel template. see original post.

    ReplyDelete
  18. Thanks for this great code

    ReplyDelete
  19. Any idea why i'm getting path not found error? It creates the first folder(first specified cell) and then nothing else.

    ReplyDelete
    Replies
    1. strange, the total path lenght might have become too long? it's not allowed to be longer than 260 characters (see http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247(v=vs.85).aspx)
      if this wouldn't be the case, you may always share the excel so I can take a closer look at it mytselection (at) gmail.com

      Delete
  20. Thanks a lot for sharing! Very usefull! Regards

    ReplyDelete
  21. It too was having a persistent error of "Path Not Found". However, after stepping through the code I discovered that my all of my root folders had lots of white space on the end. I trimmed the cell contents and then the script worked beautifully.

    Thank you for offering your work for free for others to use.

    ReplyDelete
    Replies
    1. thank you for your feedback Carla, I've updated the sheets in order to trim spaces at the start and end of a cell value since this could indeed leed to the unexpected macro exception.

      Delete
  22. Hi,

    Can this code be run from the command line as a scheduled task?

    We have program which will output nightly the folder structure required to an excel file, we hoped then to be able to schedule a task to run the code and point to the excel file so as to create the folder structure.

    Hope this makes sense!

    Adam

    ReplyDelete
    Replies
    1. Hi Adam,
      I believe it would be a better solution to integrate the folder structur creation in your exisiting program that generates the Excel file. You could base your code on the source code I shared in this post.
      But if really necessary, it would be possibel to execut the excel macro from command line, you can take a look at these instructions: http://stackoverflow.com/questions/2050505/way-to-run-excel-macros-from-command-line-or-batch-file

      Good luck!
      Regards,
      myT

      Delete
  23. I get the error Bad file name or number no matter which folder i select as the base folder, could you please help me

    ReplyDelete
    Replies
    1. Hi Harish,
      Don't really know what could be wrong...maybe you can send over your excel with a screenshot with the error and selected folder? you can mail it via mytselection [at] gmail.com

      Delete
  24. You are amazin my friend... saved me 2 hours... literally

    ReplyDelete
    Replies
    1. thx for the positive feedback! :) good to see such a small old script can still be of some help for others...

      Delete
  25. Hi,

    Congratulations for Your Folder Structure Creator tool and your new import tool. This new import tool seems to have a small bug. When I imported folder having year numbers as their name (for example : 2008, 2010, etc.), the date was replaced by this character string five out of seven times :
    2,01E+03

    I can send some print screens if needed.

    Jean

    ReplyDelete
    Replies
    1. Hi Jean,
      Thank you for your feedback. You are correct, apparently I didn't clean up the full sheet nicely after some tests. Because of this some cells have type 'Scientific' instead of the default 'General'. so the issue is not really related to dates import. Only the strange cell type becomes very visible when folder with numbers are imported. I will cleanup the download sheets but you can change the cell type in your sheet as well by selecting all cells and selecting Home -> Number: 'General' (in dropdown list)

      Kind regards,
      myT

      Delete
  26. Great job! I am looking to something very similar. How could I modify this so when I click on Create Folder Structure it creates some predefined subfolders as well as the top level?

    Thanks,

    ML

    ReplyDelete
    Replies
    1. Hi ML,
      Based on your comment, I would expect no changes are needed. You can define the structure in the Excel file and create the folder structure. The top most element in your sheet will become the top root folder.

      If you don't want to get a popup window to select the base folder in which to create the folder structure, you can easily change the VBA code shown above and specify the base folder yourself on line 17. By not calling the function BrowseForFolder, no popup will appear any longer.
      For example:
      change line 17: baseFolder = BrowseForFolder
      into: baseFolder = "C:\"

      Delete
    2. Thanks for the speedy reply! I guess I didn't do a very good job of asking my question. My intent would be to have two fields in the spreadsheet for user input. Once the button is clicked it would create those two fields as the top level folders ([CELL1] --> [CELL2]). What I would love to do is to have it create a static set of subfolders underneath. The user doesn't need to see that information is it would get a little "busy".

      Those sets of subfolders will never change so it would be nice to mask that from the user.

      Thank you so much!!

      ML

      Delete
    3. you can hide some rows of the sheet or have some parts configured in one sheet and some other parts in another sheet...you can protect the sheets in order to keep those parts hidden to the end user...

      Delete
  27. Thanks so much, it really saved tons of my time!!!

    ReplyDelete
    Replies
    1. Thank you for your feedback! Nice to see this still helps other people too, I use too from time to time ;)

      Delete
  28. Good Day

    I would like to know if there is a way to ignore the contents in hidden rows when the folder structure is created?

    Regards

    ReplyDelete
  29. Dear,

    I need this xls file.. I am not programming expert but I am looking for folder structure creater.. and I am sure this xls code will serve it..

    Can u please send the file on my email. Vaibh.world@gmail.com

    Since the file is not available on the destination location

    ReplyDelete
  30. Can you please send it to me too
    thanks

    ReplyDelete
  31. Creating a folder structure is easy when you know the hierarchy. However illustrating a structure is not that easy without a folder structure diagram tool . It also better to visualize before creating the actual folder structure.

    ReplyDelete
  32. Hi, can you send the file to me because the link to the file is no longer valid.
    cheokhs@hotmail.com

    Thanks!

    ReplyDelete
  33. Excelent macro. You are genious :) many thanks!!!!

    ReplyDelete
  34. The script looks super efficient! Would it be possible to check the link to dropbox? it gives a 404 error. thanks!

    ReplyDelete