Thursday, May 26, 2011

How do you create folders with an Excel Spreadsheet macro?


At work I often find myself having to create multiple folders before beginning a Project. Many others may take the time consuming method of doing this by hand but you can actually save yourself a lot of time by using a simple VBA macro in an Excel Spreadsheet. One method of doing this is to start a new spreadsheet and save it as a macro-enabled workbook in the location where you want to create the multiple folders (such as C:\Work Directory\Parts List)

Next, in column A list all the names of the folders you want to create. Now, hold the "Alt" key down and press "F8" to open the Macros window. Enter "CreateFolders" and click the Create button which will open the VBA editor. You can copy and paste the following code:


Sub CreateFolders()

'create the folders where-ever the workbook is saved

Dim Rng As Range

Dim maxRows, maxCols, r, c As Integer

Set Rng = Selection

maxRows = Rng.Rows.Count

maxCols = Rng.Columns.Count

For c = 1 To maxCols

r = 1

Do While r <= maxRows

If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then

MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))

On Error Resume Next

End If

r = r + 1

Loop

Next c

End Sub


 

Now all you have to do is highlight the cells and run the macro. Your folders are automatically created just like that! Save the macro and you can use it over and over again, saving you lots of time and impressing your fellow employees.

19 comments:

  1. Hmm, I create a new folder, save it as enabled workbook but when using ALT F8 the 'create' tab is not functioning - what am I doing wrong???

    ReplyDelete
  2. Is the button suppressed already? Try typing something in the Macro Name field then try hitting "Create." Hope that helps - let me know!

    ReplyDelete
  3. Yea, you just saved me countless hours... Thank you!!!

    ReplyDelete
  4. Hi,

    I tried this. It says path not found and highlights the following:

    MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))

    any idea?

    Thank you for your help :)

    ReplyDelete
  5. This works great! Except after I run the macro, excel freezes. Any ideas as to why?

    ReplyDelete
  6. Make sure your Excel file is saved as a macro-enabled workbook and you have to select the name of the folders in column A in order for it to work. I'm not sure why Excel is freezing after you run it. Maybe your file is corrupted? Have you tried creating a completely new spreadsheet?

    ReplyDelete
  7. OK it's work. But can you help me? I want to create file (listname.txt) by using that way?

    ReplyDelete
  8. WOW!!!!!!!!! THANK YOU! I LOVE YOU MAN!

    ReplyDelete
  9. This is GREAT! Just a small question: If I do not want to install the folders on the same folder where the workbook is but to a different location for example My documents....
    what is the change in code for this?

    Thanks in advance

    Luke

    ReplyDelete
  10. Actually, I figured this out Nick, just need to change the ActiveWorkbook.path to actual target destination. But now I do have another question:
    - If I need to modify the target destination every time, is there anyway of doing that without going into the code? for example, upon running the macro, a message pop-up coming on to ask where to install?

    Luke

    ReplyDelete
    Replies
    1. Hi Luke. You can add an input box to the beginning where you would type in the destination. Something like this:


      Dim strName As String

      strName = InputBox(Prompt:="Enter destination.", _
      Title:="ENTER YOUR FILE LOCATION", Default:="Your Name here")

      Let me know if you need more help than that.

      Delete
  11. Nick, thanks. Tried this but it still creates the folder in the location where the workbook I am working on is installed.
    I guess except this addition in the code you suggested, I would need to modify also the lines and point instead of Activeworkbook.path to somewhere else? The key would be that the somewhere else = location selected on the pop=up window? (I am guessing here...)

    If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then

    MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))


    By the way, another question (sorry :-)
    1) instead of a popup box where a target path needs to be manually entered, what would it take to initiate a "browser" to navigate and select the location?
    Probably insert code like this at the beginning:
    penAt = "My computer:\"

    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please Choose The Folder For This Project", 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

    ReplyDelete
    Replies
    1. To browse to the folder location instead of entering it by hand try this:

      Sub Create_Folders()
      penAt = "My computer:\"

      Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please Choose The Folder For This Project", 0, OpenAt)

      'Set the folder to that selected. (On error in case cancelled)

      On Error Resume Next
      BrowseForFolder = ShellApp.Self.Path


      'create the folders where-ever the workbook is saved

      Dim Rng As Range
      Dim maxRows, maxCols, r, c As Integer
      Set Rng = Selection
      maxRows = Rng.Rows.Count
      maxCols = Rng.Columns.Count

      For c = 1 To maxCols
      r = 1
      Do While r <= maxRows
      If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then

      MkDir (BrowseForFolder & "\" & Rng(r, c))
      On Error Resume Next
      End If
      r = r + 1
      Loop
      Next c
      End Sub

      Delete
  12. Great, thanks for this....

    ReplyDelete
  13. You saved me Hours of work! Thanks!!!!!

    ReplyDelete
  14. There's a newly updated post with video here:

    http://excelspreadsheetshelp.blogspot.com/2012/08/excel-create-folder-macro-updated.html

    ReplyDelete
  15. Your AWESOME....This worked perfectly, over 6000 new folders created in less than 5 minutes! My team THANKS YOU!!!

    ReplyDelete
  16. Works perfectly. Thanks for all the time saved by this.

    ReplyDelete

I'd love to hear from you!
-Nick