Ran into a situation this week where one of my clients wanted to save documents to a deeply nested path structure which included their clients name, the calendar year, calendar month, and then the file name. Unfortunately, many times those paths don’t exist and you cannot simply execute a command like:
mkdir “H:\ClientReports\ClientName\2019\January\”
to create the path (folder) you want, unless the previous folder already exists. To resolve this problem, I created a simple function into which I pass the full path where I want to write the file, and the function returns either a True (if the folder already exists or if the function was able to create it) or False(if the folder doesn’t already exist and attempting to create it raised an error).
Now I can use code like:
If MakeDirectory(“H:\ClientReports\ClientName\2019\January\”) = False Then
msgbox “Could not create the destination folder”
exit sub
Else
docmd.OutputTo …
End if
The function looks like the following. It probably needs a bit more in the error handler, but works find for the time being:
Public Function MakeDirectory(FullPath As String) As Boolean
Dim strPathSegments() As String
Dim intLoop As Integer
Dim strBuildPath As String
On Error GoTo ProcError
strPathSegments() = Split(FullPath, “\”)
For intLoop = LBound(strPathSegments) To UBound(strPathSegments)
If Trim(strPathSegments(intLoop)) = “” Then
‘do nothing
Else
strBuildPath = strBuildPath & strPathSegments(intLoop) & “\”
If Dir(strBuildPath, vbDirectory) = “” Then MkDir strBuildPath
End If
Next
MakeDirectory = True
ProcExit:
Exit Function
ProcError:
MakeDirectory = False
Select Case Err.Number
Case 52, 75
MsgBox “Unable to create the following folder:” & vbCrLf & vbCrLf & strBuildPath
Case Else
MsgBox Err.Number & vbCrLf & Err.Description
Debug.Print Err.Number, Err.Description
End Select
Resume ProcExit
Resume
End Function
Hi,
For more than 10 years now i use that little (german commented) function for that (part of my very old free “KnowHow mdb”) …
My freebe samples (unsorted and partly german)
https://onedrive.live.com/?id=CCB6359C11E2936D%2131173&cid=CCB6359C11E2936D
Function Path_erzeugen(ByVal Pathnamen As String, Optional CreatWarn As Boolean = True, Optional WarnOnErr As Boolean = True) As Boolean
‘ Path mit mehreren Subs auf einmal erzeugen
‘ Idee aus VB-Tips & Tricks in der BasicWorld
‘ http://www.basicworld.com
‘ Der optionale Parameter NoWarnOnErr wird als “False” interpretiert, wenn nicht vorhanden.
‘ Wenn WarnOnErr = False, dann wird keine Fehlermeldungs-Messagebox ausgegeben
‘ Wenn CreatWarn = True, dann wird gefragt, ob das Directory erzeugt werden soll, wenn es nicht existiert.
‘ Wenn versucht wird, ein Directory anzulegen, das bereits existiert, so erfolgt keine Fehlermeldung
‘Declare PtrSafe Function MakePath Lib “imagehlp.dll” Alias _
‘ “MakeSureDirectoryPathExists” (ByVal lpPath As String) As Long
Dim nix
”Pfadnamen muß immer mit einem “\” enden
If Right(Pathnamen, 1) “\” Then
Pathnamen = Pathnamen & “\”
End If
nix = Dir_Exist(Pathnamen)
If CreatWarn And nix = 0 Then ‘ Pfad existiert nicht und Warnungs-MsgBox on
nix = MsgBox(“Verzeichnis existiert nicht, soll es erstellt werden ?”, vbQuestion + vbYesNo, _
Pathnamen)
If nix = vbNo Then ‘Abbruch der Funktion
Path_erzeugen = False
Exit Function
End If
End If
‘Pfad erstellen
If MakePath(Pathnamen) = 0 Then
Path_erzeugen = False
If WarnOnErr Then
MsgBox “Verzeichnis konnte nicht erstellt werden.”, vbCritical, Pathnamen
End If
Else
Path_erzeugen = True
End If
End Function
This API also still works.
Private Declare Function MakeSureDirectoryPathExist Lib “imagehlp.dll”(ByVal lpPath As String) as Long
Public Function MakeDir(strPath as String) as Boolean
On error goto proc_err
MakeDir = true
if right(strpath, 1) “\” then strpath = strpath & “\”
MakeSureDirectoryPathExist strPath
proc_exit:
exit function
proc_err:
MakeDir = false
msgbox err.number & vbcrlf & err.description
resume proc_exit
End Function