VB6 - Is it possible to create a full path directory?

Question

Hi,

I want to to create a full path directory, like "C:\temp1\temp2\temp2" without having to make multiple "MakeDir", for each directory. Is this possible?

Is there any reference that I can add to my project that has this kind of function?

Thanks

Answer 1

You can use these functions to make the task a little easier:

Const PATH_SEPARATOR As String = "\"

'"' Creates a directory and its parent directories '''

Public Sub MakeDirectoryStructure(strDir As String)
    Dim sTemp As String

    If Right$(strDir, 1) = PATH_SEPARATOR Then
        sTemp = Left$(strDir, Len(strDir) - 1)
    Else
        sTemp = strDir
    End If
    If Dir(strDir, vbDirectory) <> "" Then
        ' Already exists.'
    Else
        'We have to create it'
        On Error Resume Next
        MkDir strDir
        If Err > 0 Then
        ' Create parent subdirectory first.'
            Err.Clear
            'New path'
            sTemp = ExtractPath(strDir)
            'Recurse'
            MakeDirectoryStructure sTemp
        End If
        MkDir strDir
    End If
End Sub  


Public Function ExtractPath(strPath As String) As String
    ExtractPath = MiscExtractPathName(strPath, True)
End Function


Private Function MiscExtractPathName(strPath As String, ByVal bFlag) As String
    'The string is treated as if it contains                   '
    'a path and file name.                                     '
    ''''''''''''''''''''''''''''''­''''''''''''''''''''''''''''''
    ' If bFlag = TRUE:                                         '
    '                   Function extracts the path from        '
    '                   the input string and returns it.       '
    ' If bFlag = FALSE:                                        '
    '                   Function extracts the File name from   '
    '                   the input string and returns it.       '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim lPos As Long
    Dim lOldPos As Long
    'Shorten the path one level'
    lPos = 1
    lOldPos = 1
    Do
        lPos = InStr(lPos, strPath, PATH_SEPARATOR)
        If lPos > 0 Then
            lOldPos = lPos
            lPos = lPos + 1
        Else
            If lOldPos = 1 And Not bFlag Then
                lOldPos = 0
            End If
            Exit Do
        End If
    Loop
    If bFlag Then
        MiscExtractPathName = Left$(strPath, lOldPos - 1)
    Else
        MiscExtractPathName = Mid$(strPath, lOldPos + 1)
    End If
End Function            ' MiscExtractPathName'

I'm not sure where I got this code.

Answer 2

Asked and answered before:

equivalent-of-directory-createdirectory-in-vb6

Answer 3

'//Create nested folders in one call

Public Function MkDirs(ByVal PathIn As String) _
   As Boolean
   Dim nPos As Long
   MkDirs = True  'assume success
   If Right$(PathIn, 1) <> "\" Then PathIn = PathIn + "\"    nPos = InStr(1, PathIn, "\")

   Do While nPos > 0
       If Dir$(Left$(PathIn, nPos), vbDirectory) = "" Then
           On Error GoTo Failed
               MkDir Left$(PathIn, nPos)
           On Error GoTo 0
       End If
       nPos = InStr(nPos + 1, PathIn, "\")
   Loop

   Exit Function
Failed:
   MkDirs = False
End Function