Make Directory

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
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
strBuildPath = strBuildPath & strPathSegments(intLoop) & “\”
If Dir(strBuildPath, vbDirectory) = “” Then MkDir strBuildPath
End If
MakeDirectory = True

Exit Function
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

End Function

2 thoughts on “Make Directory

  1. 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)

    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
    ‘ 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, _
    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
    Path_erzeugen = True
    End If

    End Function

  2. 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

    exit function

    MakeDir = false
    msgbox err.number & vbcrlf & err.description
    resume proc_exit

    End Function

Leave a Reply

Your email address will not be published. Required fields are marked *

© 2021 Developing Solutions | ScrollMe by AccessPress Themes