The VB’s MkDir function creates a directory in a specified path. If the directory already exists, MkDir raises error 75 (Path/file access error); yet, it raises the same error code if you attempt to create the directory on a read-only drive. Even worse, in Windows NT/2K/XP workstations, if you try to create a directory named “prn”, which is a reserved word, MkDir does not raise any error even though the directory is not created. An easy alternative to MkDir is provided by the FileSystemObject object. Another one involves using the CreateDirectory API function. Because this function is part of the Windows “kernel32” library, you do not have to add any references to your project or package additional DLL files with your application. You must however declare the API function as well as write some additional code:

' In the Declarations section of a BAS module:Private Type SECURITY_ATTRIBUTES    nLength As Long    lpSecurityDescriptor As Long    bInheritHandle As LongEnd TypePrivate Declare Function CreateDirectory Lib "kernel32" Alias _    "CreateDirectoryA" (ByVal lpPathName As String, _    lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long' In the same BAS module, implement a CreateDirectory API wrapper:Private Function NewDirectory(ByVal Path As String) As Long    Dim lpSA As SECURITY_ATTRIBUTES    lpSA.nLength = Len(lpSA)    If (CreateDirectory(Path, lpSA) <> 0) Then        ' NewDirectory = 0   ' Directory created    Else        NewDirectory = Err.LastDllError ' API error code    End IfEnd Function

The NewDirectory wrapper function is declared with Private scope because it is not the routine we want to access directly in code. The reason for this is that it lacks two essential components, directory name validation and descriptive error messages. Instead, we access the APIMakeDirectory function that encapsulates both EvalFileName and NewDirectory. Because APIMakeDirectory must be able to identify the meaning of the error codes returned by NewDirectory, it also encapsulates the APIErrorMessage, which a wrapper of the FormatMessage API function.The complete code of the APIMakeDirectory function – provided below – offers an additional feature that allows renaming of the new directory if it already exists in the destination path:

' API declares, types and constantsPrivate Type SECURITY_ATTRIBUTES    nLength As Long    lpSecurityDescriptor As Long    bInheritHandle As LongEnd TypePrivate Declare Function CreateDirectory Lib "kernel32" Alias _    "CreateDirectoryA" (ByVal lpPathName As String, _    lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long'Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFFPrivate Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _    (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _    ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _    Arguments As Long) As Long' The APIMakeDirectory function can be called from anywhere in the' project. It encapsulates three private (module-level) functions:'   - EvalFileName: validates the new directory name'   - NewDirectory: Creates the new directory'   - APIErrorMessage: provides a description of API error codes'' APIMakeDirectory returns True on success. Optional errCode and' errMsg arguments receive error information. If RenameOnCollision is' True and there is a name clash in the destination path, the directory' is renamed and the new name is returned in Path.'Public Function APIMakeDirectory(Path As String, Optional RenameOnCollision As _    Boolean, Optional errCode As Long, Optional errMsg As String) As Boolean    Dim RetVal As Long    Dim i As Long    Dim TempName As String    On Error GoTo exitError        ' Extract directory name    TempName = Path    For i = Len(Path) To 1 Step -1        If (Mid$(Path, i, 1) = "") Then            TempName = Mid$(Path, i + 1)            Exit For        End If    Next        ' Validate directory name    If EvalFileName(TempName) = True Then        Err.Raise 1005, , "Invalid directory name."    End If            ' Create the directory (RenameOnCollision if requested)    RetVal = NewDirectory(Path)    If RenameOnCollision Then        i = 0        TempName = Path        Do While (RetVal = 183)            i = i + 1            Path = TempName & " (" & CStr(i) & ")"            RetVal = NewDirectory(Path)        Loop    End If        If RetVal = 0 Then ' success        errCode = RetVal        errMsg = "Directory created."        APIMakeDirectory = True    Else        Err.Raise RetVal, , APIErrorMessage(RetVal)    End If    exitNormal:    Exit Function    exitError:    errCode = Err.Number    errMsg = Err.Description    Resume exitNormalEnd Function' EvalFileName ensures that the basename of a file or directory' conforms to the Microsoft file naming guidelines (see MSDN webpage)' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/base/' naming_a_file.asp'' Return value:'   True = Valid basename'   False = Invalid basename'' Note: Since EvalFileName checks only the basename of a file or' directory, it does not test the max filename length condition' (ANSI 255 for files, 248 for directories, including the path)' This error is however trapped by the APIMakeDirectory function'Private Function EvalFileName(ByVal Name As String) As Boolean                                Dim i As Long    Dim Test As String    Const BAD_FILENAME_CHARS As String = """" & "/" & "" & ":" & "|" & "<" & _        ">" & "*" & "?"        ' We need a name    If Len(Trim$(Name)) = 0 Then        Exit Function    End If        ' Test trailing space or period    Test = Right$(Name, 1)    If Test = " " Or Test = "." Then        Exit Function    End If        ' Test illegal and non-printable characters    Test = BAD_FILENAME_CHARS    For i = 0 To 31        Test = Test & Chr$(i)    Next    For i = 1 To Len(Name)        If InStr(1, Test, Mid$(Name, i, 1)) > 0 Then            Exit Function        End If    Next        ' Test possible use of reserved words    ' (CON, PRN, AUX, CLOCK$, NUL)    If LCase$(Name) = "con" Or LCase$(Name) = "prn" Or LCase$(Name) = "aux" Or _        LCase$(Name) = "clock$" Or LCase$(Name) = "nul" Then            Exit Function    End If    ' COM/LPT (1-9)    For i = 1 To 9        If LCase$(Name) = "com" & CStr(i) Or LCase$(Name) = "lpt" & CStr(i) Then            Exit Function        End If    Next        ' All tests clear, return success    EvalFileName = TrueEnd Function' CreateDirectory API wrapper function: Creates a new directory'Private Function NewDirectory(ByVal Path As String) As Long    Dim lpSA As SECURITY_ATTRIBUTES    lpSA.nLength = Len(lpSA)    If (CreateDirectory(Path, lpSA) <> 0) Then        ' NewDirectory = 0   ' Directory created    Else        NewDirectory = Err.LastDllError ' API error code    End IfEnd Function' FormatMessage API wrapper function: Returns system error description.'Private Function APIErrorMessage(ByVal errCode As Long) As String    Dim MsgBuffer As String * 257    Dim MsgLength As Long      MsgLength = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _        FORMAT_MESSAGE_IGNORE_INSERTS Or FORMAT_MESSAGE_MAX_WIDTH_MASK, 0&, _        errCode, 0&, MsgBuffer, 256&, 0&)    If (MsgLength = 0) Then        APIErrorMessage = "Unknown error."    Else        APIErrorMessage = Left$(MsgBuffer, MsgLength)    End IfEnd Function

In conclusion, I would like to point out that although RAD is a great concept, the most obvious solution is not always the most effective one. You will often need to go the extra mile in order to create reliable applications.

Click here to visit the author’s website.