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