Make Folders

PROBLEM:

"I'd like an easy way to create folders that I have listed in an Excel spreadsheet, have them get created all at once for me."

SPECIFICATIONS:

  1. No need to list directories and subdirectories separately, listing the deepest subdirectory will create all parent directories as needed
  2. Blank cells ignored in column used (column A)
  3. Works whether the final "\" is included in the list strings or not

EXAMPLE:

C:\2011\Test\

C:\2012\Test

C:\2013\Test\DeepTest\

C:\2014\Test\DeeperTest\DeeperStill

Based on the list above, this macro will create 11 directories.

Sample File: MakeDirectories.xls

Option Explicit
Sub MakeDirectories()'Author: Jerry Beaucaire'Date: 7/11/2010'Summary: Create directories and subdirectories based' on the text strings listed in column A' Parses parent directories too, no need to list separately' 10/19/2010 - International compliantDim Paths As RangeDim Path As RangeDim MyArr As VariantDim pNum As LongDim pBuf As StringDim Delim As StringSet Paths = Range("A:A").SpecialCells(xlConstants)Delim = Application.PathSeparatorOn Error Resume Next For Each Path In Paths MyArr = Split(Path, Delim) pBuf = MyArr(LBound(MyArr)) & Delim For pNum = LBound(MyArr) + 1 To UBound(MyArr) pBuf = pBuf & MyArr(pNum) & Delim MkDir pBuf Next pNum pBuf = "" Next PathSet Paths = NothingEnd Sub

USER DEFINED FUNCTION version

This version is intended to be used by other macros. Call the function and feed in a full path string, the function will make sure all the folders exist from the top of the tree all the way down.

EXAMPLE:

In cell A1 C:\2013\Test\DeepTest\

And this line of code:

MakeFolders (Range("A1").Text)
UDF
Function MakeFolders(MyStr As String)'Author: Jerry Beaucaire'Date: 7/14/2010'Summary: Create directories and subdirectories based' on the text strings fed to the function' This version is to be called by other macros' 10/19/2010 - International compliantDim MyArr As VariantDim pNum As LongDim pBuf As StringDim Delim As String
On Error Resume NextDelim = Application.PathSeparator MyArr = Split(MyStr, Delim) pBuf = MyArr(LBound(MyArr)) & Delim For pNum = LBound(MyArr) + 1 To UBound(MyArr) pBuf = pBuf & MyArr(pNum) & Delim MkDir pBuf Next pNumEnd Function