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