VB6 - Возможно ли создать каталог полного пути?

Question

Я хочу создать каталог полного пути, например, "C: \ temp1 \ temp2 \ temp2", без необходимости создавать несколько "MakeDir" для каждого каталога. Это возможно?

Могу ли я добавить ссылку на мой проект с такой функцией?

Спасибо

Answer 1

На вопрос и ответили раньше:

эквивалентный из-каталога-createdirectory-в-VB6

Answer 2

Вы можете использовать эти функции, чтобы сделать задачу немного проще:

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'

Я не уверен, откуда у меня этот код.

Answer 3

Private Declare Function MakeSureDirectoryPathExists Lib 
"imagehlp.dll" (ByVal lpPath As String) As Long

Dim mF As String

mF = FolderPath

If Right(mF, 1) <> "\" Then 
    mF = mF & "\"
    MakeSureDirectoryPathExists mF
End If

Answer 4

'//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