Эквивалент Directory.CreateDirectory () в VB6

Question

Попытка создать несколько слоев папок одновременно C: \ pie \ applepie \ receies \ без использования нескольких различных команд, есть ли простой способ, похожий на Directory.CreateDirectory ()

Answer 1

Вот код, который я использовал в одном из моих проектов. Требуется добавить ссылку на проект для объекта файловой системы.

Сначала нажмите Project -> References, прокрутите вниз до «Microsoft Scripting Runtime» и выберите его. Тогда вы можете использовать эту функцию:

Public Sub MakePath(ByVal Folder As String)

    Dim arTemp() As String
    Dim i As Long
    Dim FSO As Scripting.FileSystemObject
    Dim cFolder As String

    Set FSO = New Scripting.FileSystemObject

    arTemp = Split(Folder, "\")
    For i = LBound(arTemp) To UBound(arTemp)
        cFolder = cFolder & arTemp(i) & "\"
        If Not FSO.FolderExists(cFolder) Then
            Call FSO.CreateFolder(cFolder)
        End If
    Next

End Sub

Answer 2

'Без ссылки на FileSystemObject

Public Sub MkPath(ByVal sPath As String)
  Dim Splits() As String, CurFolder As String
  Dim i As Long
  Splits = Split(sPath, "\")
  For i = LBound(Splits) To UBound(Splits)
    CurFolder = CurFolder & Splits(i) & "\"
    If Dir(CurFolder, vbDirectory) = "" Then MkDir CurFolder
  Next i
End Sub

Answer 3

В качестве альтернативы, я написал функцию, которая принимает полный путь, включая букву диска, если это необходимо в качестве параметра. Затем он проходит путь и перехватывает ошибку VB 76 (путь не найден). Когда обработчик ошибок перехватывает ошибку 76, он создает папку, которая вызвала ошибку, и возобновляет обход пути.

    Public Function Check_Path(rsPath As String) As Boolean
        Dim dPath As String
        Dim i As Integer
        Dim sProductName As String

        On Error GoTo Check_Path_Error

        If Left$(UCase$(rsPath), 2)  Left$(UCase$(CurDir), 2) Then
            ChDrive Left$(rsPath, 2)
        End If

        i = 3
        Do While InStr(i + 1, rsPath, "\") > 0
            dPath = Left$(rsPath, InStr(i + 1, rsPath, "\") - 1)
            i = InStr(i + 1, rsPath, "\")
            ChDir dPath
        Loop
        dPath = rsPath
        ChDir dPath

        Check_Path = True

    Exit Function

    Check_Path_Error:
        If Err.Number = 76 Then     'path not found'
            MkDir dPath             'create the folder'
        Resume
    Else
        sProductName = IIf(Len(App.ProductName) = 0, App.EXEName, App.ProductName)
        MsgBox "There was an unexpected error while verifying/creating directories." _
              & vbCrLf & vbCrLf & "Error: " & CStr(Err.Number) & ", " & Err.Description &  ".", _
            vbOKOnly + vbCritical, sProductName & " - Error Creating File"
        Check_Path = False
    End If

    End Function