Нужен исходник по созданию определенного количества папок

Private Sub Command3_Click()
Dim ErrorCode As Integer, message As String, DirPath As String
Dim i As Integer, Path As String
 
    For i = 0 To 4
        Path = "c:\WA" & i ' даем имена папкам
     
    DirPath = Path
    ErrorCode = SHCreateDirectoryEx(Me.hwnd, DirPath, ByVal 0&)
    Select Case ErrorCode
     Case 0
     message = "Папка успешно создана"
     Case 80, 183
     message = "Уже есть такая папка"
     Case 161
     message = "Плохое имя папки"
     Case 206
     message = "Очень длинное имя папки"
     Case Else
     message = "Непредвиденная ошибка создания папки"
    End Select
      Print Path & "  " & message & ". Код ошибки  = " & ErrorCode
    Next i
End Sub

Private Sub Command1_Click()
On Error GoTo errorfolder:
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateFolder "c:\new_folder"
errorfolder:
If Err = 58 Then MsgBox "File already exists"
Exit Sub
End Sub

Private Sub Command1_Click()
     On Error resume next
     mkdir "c:\new_folder"
End Sub

Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Long) As Long
 
Sub fafaf()
    Dim i&, t!
    Const fpath$ = "E:\TestFolder\Test1\fold"
    t = Timer
    For i = 1 To 10000
        SHCreateDirectoryEx 0, fpath & i, 0
    Next
    Debug.Print Timer - t
End Sub

' Функция создаёт ровно столько каталогов, сколько надо
Public Function MakeDir(Path As String) As Boolean
    On Error GoTo Quit
    
    Dim DirPath As String
    Dim CurrentDirPath As String
    Dim DirPathPenultimate As String
    Dim IsDir As Boolean
    Dim DirAttr As Long
    Dim pos As Long
    Dim f1 As Long
    Dim f2 As Long
    Dim i As Long
    
    DirPath = Path
    
    If Right$(DirPath, 1) = "\" Then
        DirPath = Left$(DirPath, Len(DirPath) - 1) ' Убрать на конце косую черту, если есть
    End If
    
    f1 = InStrRev(DirPath, "\")
    f2 = InStr(DirPath, "\")
    
    If f1 > 0 Then
        If f1 = f2 Then ' Только одна косая черта (создаётся каталог в корне диска)
            MkDir DirPath ' Err 75 or 76
            MakeDir = True
        Else ' Несколько косых черт (создаётся каталог, глубже чем в корне диска)
            DirPathPenultimate = Left$(DirPath, f1 - 1)
            
            If Dir$(DirPathPenultimate, vbDirectory + 7) <> vbNullString Then
                DirAttr = GetAttr(DirPathPenultimate)
                
                If (DirAttr And vbDirectory) <> 0 Then ' Если предпоследний каталог в цепочке действительно существует
                    MkDir DirPath ' Создаётся только один каталог
                    MakeDir = True
                    Exit Function
                End If
            End If
            
            ' Создаётся два или больше двух каталогов сразу
            DirPath = DirPath & "\"
            pos = 1
            
            Do
                i = InStr(pos, DirPath, "\") ' Искать нужную нам строку
                
                If i > 0 Then
                    CurrentDirPath = Mid$(DirPath, 1, i - 1)
                    IsDir = False
                    
                    If Dir$(CurrentDirPath, vbDirectory + 7) <> vbNullString Then
                        DirAttr = GetAttr(CurrentDirPath)
                        
                        If (DirAttr And vbDirectory) <> 0 Then
                            IsDir = True
                        End If
                    End If
                    
                    If IsDir = False Then MkDir CurrentDirPath: MakeDir = True
                    pos = i + 1
                End If
            Loop While i > 0 ' Выполнять цикл до тех пор, пока будет найдена искомая подстрока
        End If
    End If
Quit:
End Function

Private Declare Function CreateDirectory Lib "kernel32.dll" Alias "CreateDirectoryA" (ByVal lpPathName As String, ByVal lpSecurityAttributes As Long) As Long
***
        CreateDirectory fpath & i, 0&

Private Declare Function SHCreateDirectory Lib "shell32" (ByVal hwnd As Long, ByVal pszPath As LongPtr) As Long
***
SHCreateDirectory 0, StrPtr(fpath & i)