Поиск файлов в подпапках и добавление в список - VB

Формулировка задачи:

Добрый день! Просто не смог придумать более подходящего названия...) Значит есть у меня маханькая программка которая формирует плей лист для трансляции клипов... т.е. просто берет все файлы из папки, "перемешивает" их и записывает в файл... Если интересно вот ее код:

Public Function CreateList()
 
PathToDir = TxtFolder.Text
    Dir1.Path = PathToDir
    File1.Path = Dir1.Path
    Dim x As Integer
        For x = 0 To File1.ListCount - 1
        List1.List(x) = File1.List(x)
        Next x
        
    Dim I As Long, j As Long, Z As String
    Dim I1 As Long, I2 As Long
    For I = 0 To List1.ListCount - 1
    Randomize Timer
        j = I + Fix(Rnd * (List1.ListCount - I))
        Z = List1.List(I)
        List1.List(I) = List1.List(j)
        List1.List(j) = Z
    Next I
    
    pathfile = TxtLoad.Text
        Open pathfile For Output As #1
        Print #1, "new c1 broadcast enabled"
        Close #1
    Open pathfile For Append As #1
    For I = 0 To List1.ListCount - 1
    Print #1, "setup c1 input ";
    Write #1, TxtFolder.Text + "\" + List1.List(I)
    Next I
    Print #1, TxtStream.Text
    Print #1, "control c1 play"
    Close #1
 
End Function

А теперь нужно сделать так, что бы не просто брались все файлы из папки, а: есть папки "1", "2", "3" и "4" с клипами.... Нужно сформировать плей лист на смену (18 часов трансляции), но что бы за смену файлы из папки "4" проиграли за смену 4 раза, из папки "3" проиграли 3 раза, и т.д. Вот сломал себе уже всю голову и даже похожего пока ничего не придумал....((( У кого есть идеи, подскажите пожалуйста хоть примерный алгоритм...

Решение задачи: «Поиск файлов в подпапках и добавление в список»

textual
                            Листинг программы 
                        

                            Dim fso, fld, fsf
 
Private Sub Command1_Click()
    On Error GoTo ErrorHandler
    get_folder App.Path
    Exit Sub
ErrorHandler:
    MsgBox Error, vbExclamation + vbOKOnly
End Sub
 
Sub get_folder(in_fold As String)
    'поиск подпапок и вызов обработки файлов текущей папки
    Set fld = fso.GetFolder(in_fold)
    Set fsf = fld.SubFolders
    
    get_file
    
    If fsf.Count <> 0 Then
        'по подпапкам
        For Each f1 In fsf
            get_folder (f1)
        Next
    End If
End Sub
 
Sub get_file()
    'поиск файлов по маске в текущей
    Set ff = fld.Files
    If ff.Count <> 0 Then
        For Each f2 In ff
            t = InStr(1, f2, "") 'ввести маску если надо
            If t > 0 Then
                k = 0 ' все остальные папки включая 1
                If IsNumeric(fld.Name) Then
                    If CInt(fld.Name) > 0 Then k = CInt(fld.Name) - 1
                End If
            End If
            For i = 0 To k
                List1.AddItem f2.Name
            Next
        Next
    End If
End Sub
 
Private Sub Form_Load()
    Set fso = CreateObject("Scripting.FileSystemObject")
End Sub
                        