Smart Folder Creation

This Sub will create a folder and the entire path to the folder if need be.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ''    
  ''    Sub SmartCreateFolder(strFolder)
  ''    Author:        ebgreen
  ''    Purpose:    Creates a folder building the entire path if needed.
  ''    Takes:        strFolder - The complete path of the folder to create
  ''    Returns:    Nothing
  ''    Revision History:
  ''        12/23/05    RMD    Created
  ''
  ''    To Do:
  ''        Nothing at present
  ''
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Sub SmartCreateFolder(strFolder)
      Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
      If oFSO.FolderExists(strFolder) Then
          Exit Sub
      Else
          SmartCreateFolder(oFSO.GetParentFolderName(strFolder))
      End If
      oFSO.CreateFolder(strFolder)
      Set oFSO = Nothing    
  End Sub
  

AAARRRGGGHHH!!!!!
Why didn't i take a look thru here earlier?!?  It would have saved me from havign to create this monstrosity to do the same thing!
 
*quietly wanders off towards the gunrack*
 

 Function fCreateFolder(sFolderPathToCreate)
 ' This function checks for the existence of a folder.  If it does not exist,
 ' it will create the folder and any parent folders that do not exist, as well.  
 ' It can handle either UNC paths or drive letter paths.
 ' The function will return an error code of 0 if no errors were encountered,
 ' and a 1 if any errors were encountered.
  Dim iStartCharacterPosition, sFolderPathPrefix, sFolderPathSuffix, aFolders, iElement, sFolderName, iError, iResult
   If Trim(sFolderPathToCreate) = "" Or IsNull(sFolderPathToCreate) or len(sFolderPathToCreate) < 4 Then
    iResult = 1
   Else 
     If Not oFSO.FolderExists(sFolderPathToCreate) Then 
       Select Case Left(Trim(sFolderPathToCreate), 2)
        Case "\\"
         iStartCharacterPosition = InStr(3, sFolderPathToCreate, "\")
         sFolderPathPrefix = Left(sFolderPathToCreate, iStartCharacterPosition)
        Case Else
         iStartCharacterPosition = 3
         sFolderPathPrefix = Left(sFolderPathToCreate, 3)
       End Select
       If Len(sFolderPathToCreate) > Len(sFolderPathPrefix) Then 
        sFolderPathSuffix = Right(sFolderPathToCreate, Len(sFolderPathToCreate) - iStartCharacterPosition)
        iResult = 0
       Else
        iResult = 1
       End If 
       Select Case iResult
        Case 0
         aFolders = Split(sFolderPathSuffix, "\")
          For iElement = 0 to UBound(aFolders)
           sFolderName = sFolderName & aFolders(iElement) & "\"
            If Not oFSO.FolderExists(sFolderPathPrefix & sFolderName) And iElement > 0 Then
             On Error Resume Next
              oFSO.CreateFolder(sFolderPathPrefix & sFolderName)
              iError = Err.Number
             On Error GoTo 0
              Select Case iError
               Case 0
                iResult = 0
               Case Else
                iResult = 1
              End Select 
            End If 
          Next
        Case Else 
         iResult = 1
       End Select 
     Else
      iResult = 0
     End If 
   End If
 fCreateFolder = iResult
 End Function
 

Recursion is your friend. 

ebgreen,
 
Could you explain how this works? I can't quite wrap my head around it. It does work great and it's so compact that you deserve a lot more than 5 stars!
 
Thanks,
Rob

The trick is to check if the parent folder already exists, and otherwise create that folder first, before creating the child folder. Using recursion you traverse the path "upwards" until you reach the bottom-most already existing folder, and then create the missing child folders descending back "downwards" in the path. The only precondition for calling the procedure is that the drive must exist, because the recursion is based on the assumption that at least the root folder of the drive exists.

You could simplify the procedure even more by checking if the folder does not exist, because then the procedure will automatically return without doing anything when a folder already exists:

Sub SmartCreateFolder(strFolder)
 Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
 If Not oFSO.FolderExists(strFolder) Then
 SmartCreateFolder oFSO.GetParentFolderName(strFolder)
 oFSO.CreateFolder(strFolder)
 End If
End Sub