If you want to create a directory with Visual Basic more than one layer deep you first must make sure that the directories above it exist. For example, the directory PROJECT directory in C:TEMPFINALPROJECT can not be created until the TEMP then the FINAL directories are created first.

Even though this code is relatively simple, it's surprising to see the number of major applications on the shelves that fail to correctly handle this scenario.

The code shown below consists of two functions. The bValDIR function is needed because in Visual Basic, if you try to create a directory using the MkDir function that already exists, MkDir will generate an error.

Code

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

If Right$(sDirName, 1) <> "" Then

sDirName = sDirName + ""

End If

'Create Nested Directory

Do 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

Loop

'Leave The Mouse The Way You Found It

Screen.MousePointer = iMouseState

End Sub

Function bValDir (sIncoming As String) As Integer

Dim iCheck As String
Dim iErrResult As Integer


On Local Error GoTo ValDirError

If Right$(sIncoming, 1) <> "" Then

sIncoming = sIncoming + ""

End If

iCheck = Dir$(sIncoming)

If iErrResult = 76 Then

bValDir = False

Else

bValDir = True

End If
Exit Function

ValDirError:

Select Case Err

Case Is = 76

iErrResult = Err

Resume Next

Case Else

End Select

End Function