Wie mit VBScript Dateien gleichmäßig in Unterordner verteilen?

Option Explicit

Dim CamFolder          ' CCDSoft Camera Objekt           
Dim Image              ' CCDSoft Image Objekt  
Dim fso                ' FileSystem Objekt  
Dim TxtFile            ' Textdatei target file  
Dim szPathToTargetFile ' Pfad zum target file  
Dim szTargetName       ' Objektname aus target file  
Dim dExposure2         ' Belichtungszeit aus target file  
Dim nSeries            ' Belichtungsserie aus target file  
Dim dRa, dDec          ' Koordinaten aus target file  
Dim imageFolder        ' Basis Ordner Bilder  
Dim tgtFolder          ' Zielobjektordner  
Dim strFolder          ' Gesamtpfad zu Objekt\RED  
Const NCOUNT = 3       ' Anzahl der zu erstellenden Unterordner  
Const FIRSTSUBFOLDER = "a" ' Buchstabe des ersten zu erstellenden Unterordners  
Dim arrSubFolder()     ' Array für Pfade der Unterordner  
Dim strSubFolderName   ' Unterordner von RED: a,b,c  
Dim strSubFolderPfad   ' Gesamtpfad zum Unterordner von RED  
Dim strFilePath        ' Pfad der zu verschiebenden Datei  

Const ForReading = 1
Dim i
Dim Extension          ' Dateierweiterung  
Const TOMOVE = "FIT" ' Dateierweiterung der zu verschiebenden Dateien in Großbuchstaben  
Dim Paths
Dim Count
Dim scount             ' Anzahl der Dateien für einen Stack  
Dim intIndexSubFolder  ' Index des aktuellen Unterordners  

szPathToTargetFile = "C:\CCD\targets\Target.txt"  
imageFolder = "C:\CCD"  
Set CamFolder = CreateObject("CCDSoft.Folder")  
Set Image = CreateObject("CCDSoft.Image")  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set TxtFile = fso.OpenTextFile(szPathToTargetFile, ForReading)	

Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Dim objShell
Dim objFolder
Dim objFolderItem
Dim objPath
		
Set objShell = CreateObject("Shell.Application")  
Set objFolder = objShell.BrowseForFolder _
	(WINDOW_HANDLE, "Select a folder:", OPTIONS, "C:\")   
		
If objFolder Is Nothing Then
	WScript.Quit
End If
		
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path

'On Error Resume Next		  
Do While Not TxtFile.AtEndOfStream
	Call GetDataFromTgtFile(TxtFile.ReadLine, szTargetName, dRa, dDec)
	 
	tgtFolder = Trim(szTargetName)
	strFolder = objPath & "\" & tgtFolder & "\RED"  

	CamFolder.Path = strFolder
	Paths = CamFolder.FilePathArray
	Count = UBound(Paths)
	scount = Int(Count / NCOUNT + .99) 'auf Ganze aufgerundete Anzahl der Dateien je Unterordner  
	
	ReDim arrSubFolder(NCOUNT - 1) ' Array für Unterordnerpfade erstellen / löschen  
	For i = 0 To NCOUNT - 1 ' Unterordner erstellen und Gesamtpfade im Array speichern  
		strSubFolderName = Chr(Asc(FIRSTSUBFOLDER) + i) 'Buchstabe als Name des aktuellen Unterordners  
		strSubFolderPath = strFolder & "\" & strSubFolderName & "\"  
		If Not fso.FolderExists(strSubFolderPath) Then fso.CreateFolder(strSubFolderPath)
		arrSubFolder(i) = strSubFolderPath
	Next
	
	For i = 0 To UBound(Paths)
		intIndexSubFolder = i \ scount ' Unterordner-Index ermitteln  
		strFilePath = Paths(i) 'Pfad der aktuellen Datei  
		Extension = UCase(fso.GetExtensionName(strFilePath)) 'Dateierweiterung der aktuellen Datei in Großbuchstaben  
		If Extension = TOMOVE Then fso.MoveFile strFilePath, arrSubFolder(intIndexSubFolder) ' Datei in den entsprechenden Unterordner verschieben  
	Next
Loop

TxtFile.Close
Set fso = Nothing
Set f = Nothing
Set Image = Nothing
Set CamFolder = Nothing

Sub GetDataFromTgtFile(LineFromFile, szTargetName, dExposure2, nSeries)
	szTargetName	= Mid(LineFromFile,1,15)
	dExposure2	= CDbl(Mid(LineFromFile,50,4))
	nSeries		= CDbl(Mid(LineFromFile,60,3))
End Sub

Do While Not TxtFile.AtEndOfStream
	Call GetDataFromTgtFile(TxtFile.ReadLine, szTargetName, dRa, dDec)
	 
	tgtFolder = "\" & RTrim(szTargetName)  
	strFolder = objPath & tgtFolder & "\RED"  
	...
Loop

For Each objSubFolder In fso.GetFolder(objPath).SubFolders
	strFolder = objSubFolder.Path & "\RED"  
	...
Next

Paths = CamFolder.FilePathArray

Count = 0
For i = 0 To UBound(Paths)
    Extension = UCase(fso.GetExtensionName(strFilePath)) 'Dateierweiterung der aktuellen Datei in Großbuchstaben  
    If Extension = TOMOVE Then Count = Count + 1
Next

intIndexSubFolder = i \ scount

On Error Resume Next