Equivalent to Directory.CreateDirectory () in VB6

Trying to create several layers of folders C: \ pie \ applepie \ recipies \ at once without using several different commands, there is an easy way similar to Directory.CreateDirectory ()

+4
source share
4 answers

Here is the code that I used in one of my projects. It requires adding a link to the project for the file system object.

First, click on Project - Links, scroll down to "Microsoft Scripting Runtime" and select it. Then you can use this function:

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
+8
source

'Without having to reference 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
+2
source

, , , , , . 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
0

Path "\\". , . FSO ?

0

Source: https://habr.com/ru/post/1699479/


All Articles