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

Option Explicit
Private Declare Function SHCreateDirectory Lib "shell32" (ByVal hwnd As Long, ByVal pszPath As Long) As Long
 
Private Sub Command1_Click()
    Dim strPath As String
    
    strPath = "C:\Love " & ChrW(&H7231)
    
    SHCreateDirectory 0, StrPtr(strPath)
End Sub

Option Explicit
 
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    'create the directory "c:\this\is\a\test\directory\", if it doesn't exist already
    'MakeSureDirectoryPathExists "c:\this\is\a\test\directory\"
    MakeSureDirectoryPathExists "c:\Этот\тест\создаёт\директории\по\указанному\пути\"
    'Me.Caption = "c:\this\is\a\test\directory\ - Создано"
    Me.Caption = "c:\Этот\тест\создаёт\директории\по\указанному\пути\"
End Sub

Private Declare Function MakeSureDirectoryPathExists Lib "Dbghelp.dll" (ByVal lpPath As String) As Long

Public Function MakeDir(ByVal strPath As String) As Boolean
    'creates a directory independent of whether the parent directory exists
    'Code by TheSmileyOne
    'Version 0.1
    'Date 2010-05-19
 
    'Known issues
    'No error handling for cases such as network drives, with restricted permissions to create folders.
    'No input validation
 
 
    On Error GoTo err_Handler
 
    'Check if rightmost char is a \
        If Right(strPath, 1) = "\" Then
            'Strip it
            strPath = Left(strPath, Len(strPath) - 1)
        End If
 
    'Check if each individual directory exists, and if not, create it
        Dim strSplitPath() As String
        ReDim strSplitPath(UBound(Split(strPath, "\")))
        strSplitPath = Split(strPath, "\")
        Dim intI As Integer
        Dim strCombined As String
 
        For intI = 0 To UBound(strSplitPath)
            If intI <> 0 Then strCombined = strCombined & "\"
 
            strCombined = strCombined & strSplitPath(intI)
            If Dir(strCombined, vbDirectory) = "" Then
                MkDir strCombined
            End If
        Next
 
     'Succes
         MakeDir = True
Exit Function
        MakeDir = False
        MsgBox "Error " & Err.Number & " occured." & vbNewLine & Err.Description
 
End Function