by Rafiq Batcha (2 Submissions)
Category: Files/File Controls/Input/Output
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Wed 3rd July 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Creating new folder, without using API functions
VBcoders
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
