EnsurePathExists: A Unicode-Safe Way to Create Missing Subfolders in VBA

This is part 3 of 3 of a series of articles on creating folder trees in VBA.

MakeSureDirectoryPathExists is a handy API function that automatically creates missing subfolders, but it has a major flaw: it does not work with Unicode folder names.

Here's the relevant excerpt from the API documentation:

[The MakeSureDirectoryPathExists] function does not support Unicode strings. To specify a Unicode path, use the SHCreateDirectoryEx function.

SHCreateDirectoryExW API

The SHCreateDirectoryExW API function provides the Unicode support that is so sorely lacking from MakeSureDirectoryPathExists.  However, this function serves a different primary purpose than simply, umm, making sure the directory path exists.

As a result, it will return an error code if we pass it the path to an existing folder.  By contrast, the MakeSureDirectoryPathExists function returns True if passed an existing folder (because the path already exists).  To account for this difference, we need to provide some additional handling of the SHCreateDirectoryExW API function's return code.

The API function only returns a SUCCESS code if it has to create one or more missing folders.  For the purposes of our function, though, the "path already exists" errors need to be treated as additional success codes.  We do that explicitly within a Select Case statement, as shown in the code below.

The Code

Private Declare PtrSafe Function SHCreateDirectoryEx _
    Lib "shell32" Alias "SHCreateDirectoryExW" _
    (ByVal hwnd As LongPtr, ByVal pszPath As LongPtr, ByVal psa As Any) As Long
    
' ----------------------------------------------------------------
' Procedure : EnsurePathExists
' DateTime  : 8/15/2022
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/ensurepathexists/
' Purpose   : Unicode-safe method to ensure a folder exists
'               and create it (and all subfolders) if it does not.
' ----------------------------------------------------------------
Function EnsurePathExists(PathToCheck As String) As Boolean
    Const ERROR_SUCCESS As Long = &H0
    Const ERROR_ACCESS_DENIED As Long = &H5         'Could not create directory; access denied.
    Const ERROR_BAD_PATHNAME As Long = &HA1         'The pszPath parameter was set to a relative path.
    Const ERROR_FILENAME_EXCED_RANGE As Long = &HCE 'The path pointed to by pszPath is too long.
    Const ERROR_FILE_EXISTS As Long = &H50          'The directory exists.
    Const ERROR_ALREADY_EXISTS As Long = &HB7       'The directory exists.
    Const ERROR_CANCELLED As Long = &H4C7           'The user canceled the operation.
    Const ERROR_INVALID_NAME As Long = &H7B         'Unicode path passed when SHCreateDirectoryEx passes PathToCheck as string.
    
    Dim ReturnCode As Long
    ReturnCode = SHCreateDirectoryEx(ByVal 0&, StrPtr(PathToCheck), ByVal 0&)
    
    Select Case ReturnCode
    Case ERROR_SUCCESS, _
         ERROR_FILE_EXISTS, _
         ERROR_ALREADY_EXISTS
        EnsurePathExists = True
    
    Case ERROR_ACCESS_DENIED: Throw "Could not create {0}.  Access denied.", PathToCheck
    Case ERROR_BAD_PATHNAME: Throw "Cannot use relative path: {0}", PathToCheck
    Case ERROR_FILENAME_EXCED_RANGE: Throw "Path too long: {0}", PathToCheck
    Case ERROR_CANCELLED: Throw "User cancelled CreateDirectory operation on {0}", PathToCheck
    Case ERROR_INVALID_NAME: Throw "Invalid path name: {0}", PathToCheck
    Case Else: Throw "Unexpected error {0} verifying path", ReturnCode
    End Select
End Function

Usage

Note that for the usage examples below, I'm using a dummy implementation of my Throw() function for demonstration purposes (see below).  In production code, I strongly recommend a combination of my full Throw() function, vbWatchdog global error handling, and automated reporting (such as via FogBugz BugzScout).

'Dummy implementation; for full code refer to:
'    https://nolongerset.com/throwing-errors-in-vba/
Private Sub Throw(Msg As String, Var As Variant)
    Debug.Print Replace(Msg, "{0}", "'" & Var & "'")
End Sub

Since the VBA IDE won't display Unicode characters, I wrote a quick test function to load a Unicode path from a local table to demonstrate that the API function works as advertised.

Function UnicodePath() As String
    UnicodePath = DLookup("PathName", "Table1")
End Function

Caveats

Additional Error Codes

The explicit list of error codes in the function is not exhaustive.  You will likely need to add support for additional codes that fall through to the Case Else statement.  

If you receive an "Unexpected error 'xxx' verifying path" error, you can find the corresponding error code here and add it to the list of error constants within the function.  As you come across them, please leave a comment below and I will update the code accordingly.

Future Support Not Guaranteed

The Microsoft documentation page for SHCreateDirectoryExW has this to say about the future of the function:

This function is available through Windows XP Service Pack 2 (SP2) and Windows Server 2003. It might be altered or unavailable in subsequent versions of Windows.

It has survived through many subsequent Windows versions since its initial support in Windows XP (or earlier).  I don't think it is going anywhere any time soon, but now you can't say I didn't warn you.

Referenced articles

Image by Hans from Pixabay

UPDATE [2022-08-24]: Added missing PtrSafe keyword to the API declaration (thanks, Chris M).