EnsurePathExists: A Unicode-Safe Way to Create Missing Subfolders in VBA
The EnsurePathExists function--based on the API function SHCreateDirectoryExW--is the ultimate tool for verifying and creating folder structures.
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
UPDATE [2022-08-24]: Added missing PtrSafe
keyword to the API declaration (thanks, Chris M).