Как разделить папку с 100к TXT файлами на 10 папок по 10к TXT файлов?

Nums = 10000
Path = "C:\Path\to"
'——————————————————
Set Items = CreateObject("Shell.Application").NameSpace(Path).Items
Items.Filter 32, "*"
For c = Items.Count - 1 To 0 Step -1
    If IsNumeric(Items.Item(c)) Then Exit For
Next
c = c + 2
CreateObject("WScript.Shell").CurrentDirectory = Path
With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(c) Then .CreateFolder c
    For Each F In .GetFolder(Path).Files
        i = i + 1
        If i/Nums = Fix(i/Nums) Then
            c = c + 1
            If Not .FolderExists(c) Then .CreateFolder c
        End If
        F.Move c & Chr(92)
    Next
End With

Nums = 10000
Path = "C:\Path\to"
'——————————————————
Set Items = CreateObject("Shell.Application").NameSpace(Path).Items
Items.Filter 32, "*"
For c = Items.Count - 1 To 0 Step -1
    If IsNumeric(Items.Item(c)) Then Exit For
Next
c = c + 1
CreateObject("WScript.Shell").CurrentDirectory = Path
With CreateObject("Scripting.FileSystemObject")
    For Each F In .GetFolder(Path).Files
        i = i + 1
        If (i-1)/Nums = Fix((i-1)/Nums) Then c = c + 1: .CreateFolder c
        F.Move c & Chr(92)
    Next
End With