CodeItBetter Programming Another VB Programming Blog

'File/Folders Handling - Create Nested Directories (in two ways)
'Using API:

Option Explicit
 
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" _
    (ByVal lpPath As String) As Long
 
Sub CreateDirectories()
    'This will create the directory "c:\this\is\a\test\directory\", if it doesn't exist already
    MakeSureDirectoryPathExists "c:\this\is\a\test\directory\"
End Sub
 
'Without Using API:

Public Function fnCreateDirectories(strPath As String)
'This function is used to create recursive directories
'This function will check for folder exist if doesn't exist then it will create it.
'For example: if strFolderPath = "C:\Temp\Testing\Temp\Testing\Temp\Testing" then
'It will check existance of the folders: C:, C:\Temp, C:\Temp\Testing, etc.
'If folders doesn't exist then it will create those folders.
'You can call this function as:
'Call CreateDirectories ("C:\Temp\Testing\Temp\Testing\Temp\Testing")
'This will create all directories and its subdirectories.

    Dim arrPath() As String
    Dim strTemp As String
    Dim i As Integer
    'strPath = "C:\Temp\Testing\Testing"

    On Error GoTo fnCreateDirectories_Error
 
    arrPath = Split(strPath, "\")
    For i = 0 To UBound(arrPath)
        'create folder paths
        If strTemp <> "" Then
            strTemp = strTemp & "\" & arrPath(i)
        Else
            strTemp = arrPath(i)
        End If
        'if folder doesn't exists then create it
        If Not fnFolderExists(strTemp) Then
            On Error Resume Next
            MkDir strTemp
        End If
    Next i
 
    On Error GoTo 0
    Exit Function
 
fnCreateDirectories_Error:
    Call MsgBox(Err.Number & " " & Err.Description, vbExclamation, App.Title)
End Function
 
Public Function fnFolderExists(strFolder As String) As Boolean
'Check if folder exists
    fnFolderExists = (Dir$(strFolder, vbDirectory) <> vbNullString)
End Function