'v5.1***************************************************** ' File: Ordner-Leeren.vbs ' Autor: dieseyer@gmx.de ' http://dieseyer.de ' ' Leert einen Ordner, in dem die enthaltenen Dateien in ' einen anderen Ordner kopiert werden. Gibt es dort bereits ' Dateien mit gleichen Namen, wird eine dreistellige Zahl ' vor der Dateiendung eingefügt. ' Unterordner werden nicht abgearbeitet. '********************************************************* Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell") Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Const QuellVerz = "c:\test1\" ' unbedingt mit \ am Ende Const ZielVerz = "c:\test2\" ' unbedingt mit \ am Ende ' Zielverzeichnis anlegen, wenn nicht vorhanden if not fso.FolderExists( ZielVerz ) then fso.CreateFolder ( ZielVerz ) ' Wenn es das Quellverzeichnis nicht gibt, macht das Skript keinen Sinn - Quit if not fso.FolderExists( QuellVerz ) then MsgBox UCase( QuellVerz ) & " existiert nicht!" & vbCRLF & vbCRLF & " . . . das ist das Ende.", , WScript.ScriptName WScript.Quit End If Do DateiCheck QuellVerz, ZielVerz ' Sub - Aufruf If not fso.FileExists( WScript.ScriptName ) Then Exit Do ' sobald es das Skript nicht mehr gibt WScript.Sleep 1000*10 ' 10s warten Loop MsgBox "Das ist das Ende . . . ", , WScript.ScriptName WScript.Quit ' ********************************************************* Sub DateiCheck( QuellVerz, ZielVerz ) ' Anfang ' ********************************************************* ' Dim oFiles, Folder, oFolders, QuellDatei, ZielDatei ' Dim i, n, Text, Pfad, DateiX Dim i, n Dim oFolders, oFiles, DateiX Dim QuellDatei, ZielDatei Set oFolders = fso.GetFolder( QuellVerz ) Set oFiles = oFolders.Files For Each DateiX In oFiles ' jede Datei im Ordner QuellDatei = QuellVerz & DateiX.Name ' Datei mit komplettem Pfad If not fso.FileExists( ZielVerz & DateiX.Name ) Then ' gibt es diese Datei im ZielVerz. nicht On Error Resume Next ' verhindert den Skriptabbruch bei Fehler fso.MoveFile QuellDatei, ZielVerz & DateiX.Name ' Datei ins ZielVerz. verschieben On Error GoTo 0 Else i = 0 ' Dateinummer Do n = i If Len( n ) = 1 Then n = "0" & n ' auf zweistellig erweitern If Len( n ) = 2 Then n = "0" & n ' auf dreistellig erweitern n = "_" & n & "." ' erweitern um Untersrtich und Punkt ZielDatei = ZielVerz & fso.GetBaseName( QuellDatei ) & n & fso.GetExtensionName( QuellDatei ) If not fso.FileExists( ZielDatei ) Then On Error Resume Next ' verhindert den Skriptabbruch bei Fehler fso.MoveFile QuellDatei, ZielDatei On Error GoTo 0 Exit Do End If i = i + 1 ' Dateinummer wird hochgezählt Loop End If Next Set oFiles = nothing Set oFolders = nothing End Sub ' DateiCheck()