'*** v7.8 *** www.dieseyer.de ***************************** ' ' Datei: dateienaltverschieben.vbs ' Autor: dieseyer@gmx.de ' Auf: www.dieseyer.de ' ' Verschiebt alle Dateien, die seit einem bestimmten Datum ' nicht mehr geändert wurden. Gibt es den ZielDateiNamen ' bereits, wird dieser mit einer dreistelligen Zahl fort- ' laufend hoch gezählt. ' ' z.Z. kopiert das Skript - kein Verschieben! ' Es müssen die beiden Zeile getauscht werden: ' fso.MoveFile Tst, ZDatei ' fso.CopyFile Tst, ZDatei ' '********************************************************* Option Explicit Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim QuellPfad, ZielPfad, Alter Dim LogDatei : LogDatei = WScript.ScriptFullName & ".log" QuellPfad = "H:\\scr\backup" QuellPfad = "\\dieseyer.pc.netz\d$\temp.zw" QuellPfad = "SRV01.BEIMIR.LOKAL\d$\1test" ZielPfad = "D:\temp.zw\zw" Alter = 365 ' Dateien, die seit xxx Tagen nicht geändert wurden LogEintrag vbCRLF LogEintrag "027 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )" LogEintrag "028 :: LogDatei: " & LogDatei ' MsgBox AlteVerschieben (QuellPfad, ZielPfad, Alter ) ' Function Aufruf und Ergebnisanzeige AlteVerschieben QuellPfad, ZielPfad, Alter ' Function Aufruf OHNE Ergebnisanzeige LogEintrag "033 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )" CreateObject("Wscript.Shell").Run LogDatei ' LogDatei anzeigen WScript.Quit '********************************************************* Function AlteVerschieben (QPfad, ZPfad, Tage) ' Anfang '********************************************************* Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") LogEintrag "044 :: Start der Function-Prozedur 'Function AlteVerschieben (QPfad, ZPfad, Tage)'" LogEintrag "045 :: QPfad: " & QPfad LogEintrag "046 :: ZPfad: " & ZPfad LogEintrag "047 :: Dateien, die älter als " & Tage & " Tage sind (vor dem " & FormatDateTime( now() - Tage ,2) & " erstellt), sollen verschoben werden . . ." Dim oFiles, n, i, Txt, Tst, ZDatei, File If not InStrRev( ZPfad, "\" ) = Len( ZPfad ) Then ZPfad = ZPfad & "\" ' evtl. fehlendes \ am Ende entfernen If not fso.FolderExists( QPfad ) Then AlteVerschieben = "Das Quellverzeichnis " & UCase( QPfad ) & " existiert nicht!" MsgBox AlteVerschieben, , "055 :: " & WScript.ScriptName LogEintrag "056 :: " & AlteVerschieben Exit Function End If If not fso.FolderExists( ZPfad ) Then AlteVerschieben = "Das Zielverzeichnis " & UCase( ZPfad ) & " existiert nicht!" MsgBox AlteVerschieben, , "062 :: " & WScript.ScriptName LogEintrag "063 :: " & AlteVerschieben Exit Function End If Set oFiles = fso.GetFolder( QPfad ).Files For Each File In oFiles Txt = File.DateLastModified If DateDiff("d" , File.DateLastModified, FormatDateTime( now() - Tage ,2) ) > 0 Then ' Datei alt genug? i = i + 1 n = 0 : Tst = "" ZDatei = File ZDatei = ZPfad & fso.GetBaseName( File) & Tst & "." & fso.GetExtensionName( File ) Do ' Schleife durchlaufen, bis ein 'freier' (Ziel-) Dateiname gefunden ist If not fso.FileExists( ZDatei ) Then Exit Do n = n + 1 : Tst = n If Len( Tst ) < 3 Then Tst = "0" & Tst If Len( Tst ) < 3 Then Tst = "0" & Tst If Len( Tst ) < 3 Then Tst = "0" & Tst ' n mit führenden Nullen auffüllen Tst = "-" & Tst ZDatei = ZPfad & fso.GetBaseName( File) & Tst & "." & fso.GetExtensionName( File ) ' MsgBox "File" & vbTab & "=>" & File & "<=" & vbCRLF & "ZDatei" & vbTab & "=>" & ZDatei & "<=", , "085 :: " & WScript.ScriptName Loop Tst = File On Error Resume Next ' fso.MoveFile Tst, ZDatei fso.CopyFile Tst, ZDatei On Error GoTo 0 If not fso.FileExists( ZDatei ) Then AlteVerschieben = AlteVerschieben & i & vbTab & Tst & vbTab & " nicht verschiebbar." & vbCRLF LogEintrag "096 :: Datei vom " & Txt & " nicht verschiebbar: " & Tst Else AlteVerschieben = AlteVerschieben & i & vbTab & ZDatei & vbTab & " erstellt - Quelle gelöscht." & vbCRLF LogEintrag "099 :: Datei vom " & Txt & " verschoben nach: " & ZDatei & " - QuellDatei: " & Tst End if Else LogEintrag "103 :: --- Datei vom " & File.DateLastModified & " nicht alt genung zum verschieben: " & File End If Next Set oFiles = nothing Set fso = nothing LogEintrag "110 :: " & i & " Dateien, die älter als " & Tage & " Tage sind (vor dem " & FormatDateTime( now() - Tage ,2) & " erstellt), wurden verschoben." End Function ' AlteVerschieben (QPfad, ZPfad, Tage) '********************************************************* Sub LogEintrag( LogTxt ) '********************************************************* Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim FileOut ' Dim LogDatei : LogDatei = "c:\LOG.s\" & WScript.Scriptname & ".log" If LogTxt = "" Then Set FileOut = fso.OpenTextFile( LogDatei, 2, true) FileOut.Close Set FileOut = Nothing Set fso = Nothing Exit Sub End If Set FileOut = fso.OpenTextFile( LogDatei, 8, true) If LogTxt = vbCRLF Then FileOut.WriteLine ( LogTxt ) ' If not LogTxt = vbCRLF Then FileOut.WriteLine ( Now() & vbTab & LogTxt ) If not LogTxt = vbCRLF Then FileOut.WriteLine ( Now() & " " & LogTxt ) FileOut.Close Set FileOut = Nothing Set fso = Nothing End Sub ' LogEintrag( LogTxt )