[IncludeBorders/top.htm]

MakeDirMulti Function To Replace MkDir This page has been replaced. If you are not automatically redirected, click here.

  In VBA, you can use the MkDir function to create a  new folder or subfolder. However, the folder in which that new folder is to be created must exist. You cannot pass a folder specification like C:\Test\SubA\SubB\SubC  to MkDir and expect MkDir to create all the folders.  MkDir doesn't work that way. In this example,  the folders C:\Test\SubA\SubB must already exist and MkDir will create only SubC. The function MakeDirMulti, described on this page, allows you to pass a string like the one shown above to the function and it will create all the folders necessary. Therefore, instead of parsing out each directory name from a string and creating each directory separately, your code can call MakeDirMulti with one line of code. The code for MakeDirMulti is shown below, and is available as a downloadable bas module file here.

The MakeDirMulti function returns True if the directories were successfully created, or False if an error occurred (typically an invalid character in a folder name). It will return True if no directories were created (all directories already existed).

Option Explicit
Option Compare Text

Public Function MakeDirMulti(DirSpec As String) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MakeDirMulti
' This creates multiple nested directories. This is a
' replacement function for the VBA MkDir function. MkDir
' will create only the last (right-most) directory of a
' path specification, and all directories to the left of the
' last director must already exist. For example, the following
' will fail
'       MkDir "C:\Folder\Subfolder1\Subfolder2\Subfolder3"
' will fail unless "C:\Folder\Subfolder1\Subfolder2\" already
' exists. MakeDirMulti will create all the folders in
' "C:\Folder\Subfolder1\Subfolder2\Subfolder3" as required.
' If a "\\" string is found, it is converted to "\".
' At present, MakeDirMulti supports local and mapped drives,
' but not UNC paths.
' The function will return True even if no directories were
' created (all directories in DirSpec already existed).
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Long
Dim Arr As Variant
Dim DirString As String
Dim TempSpec As String
Dim DirTestNeeded As Boolean
Const MAX_PATH = 260

''''''''''''''''''''''''''''''''
' Ensure DirSpec is valid.
''''''''''''''''''''''''''''''''
If Trim(DirSpec) = vbNullString Then
    MakeDirMulti = False
    Exit Function
End If
If Len(DirSpec) > MAX_PATH Then
    MakeDirMulti = False
    Exit Function
End If
If Not ((Mid(DirSpec, 2, 1) = ":") Or (Mid(DirSpec, 3, 1) = ":")) Then
    MakeDirMulti = False
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''
' Set DirTestNeeded to True. This
' indicates that we need to test to
' see if a folder exists. Once we
' create the first directory, there
' will no longer be a need to call
' Dir to see if a folder exists, since
' the newly created directory will, of
' course, have no existing subfolders.
''''''''''''''''''''''''''''''''''''''
DirTestNeeded = True
TempSpec = DirSpec
'''''''''''''''''''''''''''''''''''''
' If there is a trailing \ character,
' delete it.
'''''''''''''''''''''''''''''''''''''
If Right(TempSpec, 1) = "\" Then
    TempSpec = Left(TempSpec, Len(TempSpec) - 1)
End If

'''''''''''''''''''''''''''''''''
' Split DirSpec into an array,
' delimited by "\".
'''''''''''''''''''''''''''''''''
Arr = Split(expression:=TempSpec, delimiter:="\")
''''''''''''''''''''''''''''''''''''
' Loop through the array, building
' up DirString one folder at a time.
' Each iteration will create
' one directory, moving left to
' right if the folder does not already
' exist.
''''''''''''''''''''''''''''''''''''
For Ndx = LBound(Arr) To UBound(Arr)
    '''''''''''''''''''''''''''''''''
    ' If this is the first iteration
    ' of the loop, just take Arr(Ndx)
    ' without prefixing it with the
    ' existing DirString and path
    ' separator.
    '''''''''''''''''''''''''''''''''
    If Ndx = LBound(Arr) Then
        DirString = Arr(Ndx)
    Else
        DirString = DirString & Application.PathSeparator & Arr(Ndx)
    End If
    On Error GoTo ErrH:
    ''''''''''''''''''''''''''''''''''
    ' Only call the Dir function
    ' if we have yet to create a
    ' new directory. Once we create
    ' a new directory, we no longer
    ' need to call Dir, since the
    ' newly created folder will, of
    ' course, have no subfolders.
    '''''''''''''''''''''''''''''''''
    If DirTestNeeded = True Then
        If Dir(DirString, vbDirectory + vbSystem + vbHidden) = vbNullString Then
            DirTestNeeded = False
            MkDir DirString
        End If
    Else
        MkDir DirString
    End If
    On Error GoTo 0
Next Ndx

MakeDirMulti = True
Exit Function

ErrH:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If an error occured, typically because an invalid
' character was encountered in a directory name, return
' False.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MakeDirMulti = False

End Function
  
     
     
[IncludeBorders/bottom.htm]