Visual Basic > Files Directories Drives

How to create a file directory and subdirectories at runtime.

How to create a file directory and subdirectories at runtime.

' Here's how to create a file directory and subdirectories
           
' Add these 3 functions and the MakeDir subroutine:

' This function is used by MakeDir to validate if a
' directory already exists.

Function bValDir (ByVal sDirIn As String) As Integer
Dim iCheck As String, iErrResult As Integer

On Local Error GoTo ValDirError
    sDirIn = sParsePath(sDirIn)
    sDirIn = sFixDirString(sDirIn)

    iCheck = Dir$(sDirIn)

    If iErrResult <> 0 Then
    bValDir = False
    Else
        bValDir = True
    End If

    Exit Function

ValDirError:

    iErrResult = Err
    Resume Next
 
End Function

' This procedure will add a \ to the end of the directory
' name if needed.

Function sFixDirString (sInComming As String) As String
Dim sTemp As String

    sTemp = sInComming

    If Right$(sTemp, 1) <> "\" Then
    sFixDirString = sTemp & "\"
    Else
    sFixDirString = sTemp
    End If

End Function

' This procedure will return just the path name from the 
' string containing the path.

Function sParsePath (sPathIn As String) As String
Dim I As Integer

   For I = Len(sPathIn) To 1 Step -1
      If InStr(":\", Mid$(sPathIn, I, 1)) Then Exit For
   Next
   sParsePath = Left$(sPathIn, I)

End Function

' The MakeDir routine will create a directory even if the 
' underlying directories do not exist.      

Sub MakeDir (sDirName As String)
Dim iMouseState As Integer
Dim iNewLen As Integer
Dim iDirLen As Integer

    'Get Mouse State
    iMouseState = Screen.MousePointer

    'Change Mouse To Hour Glass
    Screen.MousePointer = 11

    'Set Start Length To Search For [\]
    iNewLen = 4

    'Add [\] To Directory Name If Not There
    sDirName = sFixDirString(sDirName)

    'Create Nested Directory
    While Not bValDir(sDirName)
    iDirLen = InStr(iNewLen, sDirName, "\")
    
    If Not bValDir(Left$(sDirName, iDirLen)) Then
        MkDir Left$(sDirName, iDirLen - 1)
    End If
    
    iNewLen = iDirLen + 1
    Wend

    'Leave The Mouse The Way You Found It
    Screen.MousePointer = iMouseState

End Sub

'Example:

' For instance, typing "C:\aaa\biggins" in Text1 will create
' the directory named "C:\aaa" and also create a subdirectory 
' under "C:\aaa" called "biggins" (C:\aaa\biggins)
' Typing "\aaa" will create the directory on the current drive

Sub Command1_Click ()
Dim sDirString As String

        'Use the string in Text1
        sDirString = Text1.Text

        'Trap for errors   
        On Error GoTo ErrHandle

        'Call the MakeDir routine
        MakeDir sDirString

ErrHandle:
    MsgBox Error$
Exit Sub

End Sub