ForceMkDir

The MkDir statement allows only one folder to be created at a time. The folder must exist for another folder to get created within it. ForceMkDir() routine creates a folder and all parent folders that do not exist.

Function FolderExists(ByVal S As String) As Boolean
    FolderExists = Dir(S, vbDirectory) <> ""
End Function

Function ExtractFilePath(ByVal S As String) As String
    Dim I As Long

    I = InStrRev(S, "\")
    If I = 0 Then
        I = InStrRev(S, ":")
    End If

    ExtractFilePath = Left(S, I)
End Function

Sub ForceMkDir(ByVal S As String)
    If Mid(S, Len(S), 1) = "\" Then
        S = Left(S, Len(S) - 1)
    End If

    If (Len(S) < 3) Or FolderExists(S) Or (ExtractFilePath(S) = S) Then
        Exit Sub
    End If

    ForceMkDir ExtractFilePath(S)
    MkDir S
End Sub

Contact OfficeOne on email at officeone@officeoneonline.com. Copyright © 2001-2023 OfficeOne. All rights reserved.