http://dieseyer.de • all rights reserved • © 2011 v11.4

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

http://dieseyer.de • all rights reserved • © 2011 v11.4