'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()