• Home
 · 
• Files/File Controls/Input/Output
 · 
• Creating new folder, without using API functions

Creating new folder, without using API functions

Creating new folder, without using API functions

Rate Creating new folder, without using API functions

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    Dim objFSO As Variant
    Dim CurFolderPath As String
    Dim NewFolderPath As String
    Dim TempFolder As String
    Dim i As Integer
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    If objFSO.DriveExists(Mid$(p_FolderPath, 1, InStr(1, p_FolderPath, ":"))) Then
        CurFolderPath = ReturnFolderName(p_FolderPath)
        NewFolderPath = p_FolderPath
        Do While InStr(1, CurFolderPath, "\") > 0
            If objFSO.DriveExists(CurFolderPath) = False Then
                NewFolderPath = NewFolderPath & "«" & CurFolderPath
                CurFolderPath = ReturnFolderName(CurFolderPath)
            Else
                For i = Len(Trim$(NewFolderPath)) To 1 Step -1
                    If Mid$(NewFolderPath, i, 1) = "«" Then
                        TempFolder = Mid$(NewFolderPath, (i + 1), Len(NewFolderPath))
                        NewFolderPath = Mid$(NewFolderPath, 1, (i - 1))
                        If objFSO.FolderExists(TempFolder) = False Then objFSO.CreateFolder (TempFolder)
                        TempFolder = ""
                    ElseIf InStr(1, NewFolderPath, "«") = 0 And InStr(1, NewFolderPath, ":") > 0 Then
                        If objFSO.FolderExists(NewFolderPath) = False Then objFSO.CreateFolder (NewFolderPath)
                        NewFolderPath = ""
                        Exit For
                    End If
                Next i
                CurFolderPath = ""
                Exit Do
            End If
        Loop
    Else
        Set objFSO = Nothing
        MsgBox "Drive not found", , App.ProductName
        Exit Sub
    End If
    Set objFSO = Nothing
End Sub

Private Function ReturnFolderName(p_PathFolder As String) As String
    Dim i As Integer
    
    ReturnFolderName = ""
    For i = Len(p_PathFolder) To 1 Step -1
        If Right(p_PathFolder, 1) = "\" Then
            p_PathFolder = Left(p_PathFolder, Len(p_PathFolder) - 1)
        Else
            If Mid$(p_PathFolder, i, 1) = "\" Then
                ReturnFolderName = Mid$(p_PathFolder, 1, i)
                Exit For
                Exit Function
            End If
        End If
    Next i
End Function