Classic VB Corner

Creating Nested Folders

Classic VB provides no simple method to create nested directory folders, but it certainly provides the tools to make such a method.

• By Karl E. Peterson
• 02/04/2010

A case in point. Yes, you can create nested folders with a single API call:

Private Declare Function SHCreateDirectoryExW Lib "shell32" _
   (ByVal hWnd As Long, ByVal lpszPath As Long, _
   ByVal lpSA As Long) As Long

Public Function PathMakeDirs(ByVal Path As String) As Boolean
   Dim nRet As Long
   ' Potential error codes.
   Const ERROR_SUCCESS As Long = 0&
   Const ERROR_FILENAME_EXCED_RANGE As Long = 206&
   Const ERROR_BAD_PATHNAME As Long = 161&
   Const ERROR_PATH_NOT_FOUND As Long = 3&
   Const ERROR_FILE_EXISTS As Long = 80&
   Const ERROR_ALREADY_EXISTS As Long = 183&
   Const ERROR_CANCELLED As Long = 1223&
   ' Requires v5.0 of Shell32.dll...
   nRet = SHCreateDirectoryExW(0&, StrPtr(Path), 0&)
   ' Treat "already exists" as success...
   PathMakeDirs = _
      (nRet = ERROR_SUCCESS) Or _
      (nRet = ERROR_FILE_EXISTS) Or _
      (nRet = ERROR_ALREADY_EXISTS)
End Function

Nice, neat, almost fully-contained (you still need to have the declare separate from the code). What's not to like? Well, if you start digging, you'll find the SHCreateDiretoryEx API function requires v5.0 of shell32.dll, which in turn requires IE5 or higher. But, there's a gotcha -- IE5 does not distribute this DLL itself (see Note 3), so your application must be running on either Windows 2000 or ME (or higher) to find this export.

Granted, that's a diminishing concern these days. But what's the point of upping an application's minimum requirements over something that can rather simply be accomplished with native code? Cutting to the chase:

Public Function MkDirs(ByVal Folder As String) As Boolean
   Dim f() As String
   Dim attr As Long
   Dim first As Long
   Dim i As Long

   ' Split incoming folder into subfolders.
   f = Split(Folder, "\")
   For i = 1 To UBound(f)
      f(i) = f(i - 1) & "\" & f(i)
   Next i

   ' If the input path is UNC, the first element
   ' will be empty and the second "\", so we need
   ' to adjust where we start creating folders.
   If f(0) = "" And UBound(f) > 0 Then
      If f(1) = "\" Then
         first = 4  'fourth element is first path.
      End If
   End If

   ' Use errors to signal need to take action.
   On Error Resume Next
   For i = first To UBound(f)
      ' Check if this level already exists.
      attr = GetAttr(f(i))
      If Err.Number Then
         ' Folder likely doesn't exist,
         ' clear error and create.
         Err.Clear
         MkDir f(i)
         If Err.Number Then Exit For
      End If
   Next i

   ' Return success?
   MkDirs = CBool(GetAttr(Folder) And vbDirectory)
End Function

It looks like a lot of code, but it's not all that bad really. And you can cut/paste it from project to project without dragging any needless baggage along at all. There are a lot of ways one might approach this, but the basic concept is to make one directory after another, starting from the top, until you reach the final one.

The first task is to split the incoming path into all its constituent subpaths. My preference is to then recombine them such that I end up with an array containing each full path on the way to the final. That's somewhat non-intuitive, so let's look at what that section produces. If you pass "C:\Folder1\Folder2\Folder3\Folder4" through this code:

   ' Split incoming folder into subfolders.
   f = Split(Folder, "\")
   For i = 1 To UBound(f)
      f(i) = f(i - 1) & "\" & f(i)
   Next i

You end up the f() array being filled with:

   "C:"
   "C:\Folder1"
   "C:\Folder1\Folder2"
   "C:\Folder1\Folder2\Folder3"
   "C:\Folder1\Folder2\Folder3\Folder4"

See where we're going? The only complicating factor might be if the input string was a UNC path. If the input string was, "\\Server\Share\Folder1\Folder2\Folder3", then the resulting array would be:

   ""
   "\"
   "\\Server"
   "\\Server\Share"
   "\\Server\Share\Folder1"
   "\\Server\Share\Folder1\Folder2"
   "\\Server\Share\Folder1\Folder2\Folder3"
   "\\Server\Share\Folder1\Folder2\Folder3\Folder4"

And that could be a bit of a problem if we were to try creating folders starting at the first element, because we can't create a folder based on an empty string. So we need to detect the UNC situation, and start creating folders at the fourth element in the array in that situation. The straight-forward test is to look at the first two elements, and consider it a UNC path if they are "" and "\" respectively.

   If f(0) = "" And UBound(f) > 0 Then
      If f(1) = "\" Then
         first = 4  'fourth element is first path.
      End If
   End If

From this point onward, it's as simple as looping through the array, and attempting to create any folder we find doesn't yet exist. We test for existence using GetAttr (never use Dir for this!) and create the folder if it isn't yet there. (In case you're wondering, "C:", ".", and ".." all return values from GetAttr without error.) If an error is encountered in creating the folder, we've done all we can and the folder can't be created with the current permissions structure.

To assign a result code, we simply check if the requested folder exists:

   MkDirs = CBool(GetAttr(Folder) And vbDirectory)

Simple stuff! This reminds us to not always go in search of an API when our language has these sorts of capabilities built right in. I'm not even sure if I'll need to post this on my website, but I may in case I see a need to update it after publication here.