VBS- Ordner automatisch erstellen und datei reinkopieren

Dim QuellOrdner, QuellTyp, ZielOrdner, position1, position2, datumString, lange 
QuellOrdner = "C:\Temp\TestDateien"   
QuellTyp = "txt"   
ZielOrdner = "C:\Temp\AblageTestDateien\" & Mid(datumString, 1,4) & "\" & Mid(datumString, 5,6) & "\" & Mid(datumString, 7,8)   
Set fso = CreateObject("Scripting.FileSystemObject")   
'Zielordner (bei Bedarf) erstellen   

Ziel = Split(ZielOrdner, "\") 'Teilpfade durch Zerlegung anhand der "\" bilden   
ZielPfad = Ziel(0) 'Start mit Laufwerk   

For i = 1 To UBound(Ziel) 
    ZielPfad = ZielPfad & "\" & Ziel(i) 'ZielPfad um jeweiligen Teilpfad verlängern   
    If Not fso.folderExists(ZielPfad) Then fso.CreateFolder(ZielPfad) 'und bei Bedarf erstellen   
Next 
'Dateien kopieren   
For Each Datei In fso.GetFolder(QuellOrdner).Files 'alle Dateien des QuellOrdners durchgehen   
	
	position1 = InStr(Datei, "_") ' Suche die Position von "_" aus Dateiname  
	position2 = InStr(Datei, ".") ' Suche die Position von "." aus Dateiname  
	lange = len(position1 - position2) '  
	datumString = mid(Datei, position1, lange) 'Mid (string, start,  [length] )  
	
    If LCase(fso.GetExtensionName(Datei.Name)) = LCase(QuellTyp) Then 'Datei des gesuchten Typs?   
        If Not fso.FileExists(ZielOrdner & "\" & Datei.Name) Then 'gleichnamige Datei bereits vorhanden?			  
			
			MsgBox position
    	    Datei.Copy ZielOrdner & "\" 'Zielangabe mit abschließendem "\" = Ordner   
        Else 
         'Namenskollision - was tun?   

        End If 
    End If 
Next

Dim Fso, QuellOrdner, QuellTyp, ZielOrdner, ZielPfad, Datei, Datum, Folder, Folders 
Dim StrJahr, StrMonat, Str, Tagposition1, position2, datumString, lange1, lange2 , Datum_TEST

ZielOrdner = "C:\Temp\AblageTestDateien"  
QuellOrdner = "C:\Temp\TestDateien"   
QuellTyp = "txt"   

Set Fso = CreateObject("Scripting.FileSystemObject")   

For Each Datei In Fso.GetFolder(QuellOrdner).Files 'alle Dateien des QuellOrdners durchgehen  
    If LCase(Fso.GetExtensionName(Datei.Name)) = LCase(QuellTyp) Then 'Test Datei-Typ  
        'und hier steht der restliche Code  
        '1. Datum aus Datei.Name isolieren (Datum = ) und zerlegen -> Folders = Array(JJJJ, MM, TT)  
		
			position1 = InStr(Datei.Name, "_") ' Suche die Position von "_" aus Dateiname  
			position2 = InStr(Datei.Name, ".") ' Suche die Position von "." aus Dateiname  
			lange1 = position1 + 1
			Datum =  mid(Datei.Name, lange1, 8) 'Gibt 8 Zeichnen zurück ab Startposition lange1  
			StrJahr = mid(Datum, 1,4)
			StrMonat = mid(Datum, 5,2) ' 2 Zeichen ab Position 5  
			StrTag = mid(Datum, 7,2)   ' 2 Zeichen ab Position 7  
			
			
		
        '2. ZielPfad = ZielOrdner (für jede Datei erneut den ZielOrdner (Start-Ordner) vorgeben)  
        '3. For Each-Schleife (Folder In Folders) FolderExists/CreateFolder (ZielPfad = ZielPfad & "\" & Folder)  
        '4. Test FileExists(ZielPfad), Datei.Move (Verschieben, wenn die Datei im Quell-Ordner eh gelöscht werden soll)  
    End If
Next

Dim Fso, QuellOrdner, QuellTyp, ZielOrdner, ZielPfad, Datei, Datum, Folder, Folders, DateiPfad

ZielOrdner = "C:\Temp\AblageTestDateien"  
QuellOrdner = "C:\Temp\TestDateien"  
QuellTyp = "txt"  

Set Fso = CreateObject("Scripting.FileSystemObject")  

For Each Datei In Fso.GetFolder(QuellOrdner).Files 'alle Dateien des QuellOrdners durchgehen  
    If LCase(Fso.GetExtensionName(Datei.Name)) = LCase(QuellTyp) Then 'Test Datei-Typ  
       
       '1. Datum aus Datei.Name isolieren, auf Zahlenwert testen und in Array zerlegen -> Folders = Array(JJJJ, MM, TT)  
        Datum = Right(Fso.GetBaseName(Datei.Name), 8) 'z.B. Textdatei_20110225.txt, dann Datum = 20110225  
         
        If IsNumeric(Datum) Then 'Test ob Datum eine Zahlenwert ist  
            Folders = Array(Left(Datum, 4), Mid(Datum, 5, 2), Right(Datum, 2)) 'Folders = Array(JJJJ, MM, TT)  
	   
           '2. ZielPfad = ZielOrdner (für jede Datei erneut den ZielOrdner (Start-Ordner) vorgeben)  
            ZielPfad = ZielOrdner
	   
           '3. For Each-Schleife (Folder In Folders) FolderExists/CreateFolder (ZielPfad = ZielPfad & "\" & Folder)  
		For Each Folder In  Folders
			ZielPfad = ZielPfad & "\" & Folder 'ZielPfad um jeweiligen Teilpfad verlängern   
			If Not fso.folderExists(ZielPfad) Then fso.CreateFolder(ZielPfad) 'und bei Bedarf erstellen   
		Next
		   
           '4. Test FileExists(ZielPfad & ...), Datei.Move (Verschieben, wenn Datei im Quell-Ordner gelöscht werden soll)  
		If Not fso.FileExists(ZielPfad & "\" & Datei.Name) Then 'gleichnamige Datei bereits vorhanden?   
    	    Datei.Copy ZielPfad & "\" 'Zielangabe mit abschließendem "\" = Ordner   
			
			'AbsolutePathName der Dateien auslesen und in der Datenbank Tabelle speichern  
			DateiPfad = fso.GetAbsolutePathName(ZielPfad) & "\" & Datei.Name  
			
        Else 
		End If
		   
        End If
    End If
Next