- #1
S
Seebachler
Neues Mitglied
Themenersteller
- Dabei seit
- 06.09.2011
- Beiträge
- 1
- Reaktionspunkte
- 0
Hi,
ich habe folgendes VBScript seit Jahren unter WIN-XP problemlos in Verwendung. Unter Vista und Win7 tritt aber ein komischer Effekt auf. Manchmal tut das Script so, wie wenn es nichts zu sichern gäbe in den ganzen Dateibaum /Users/Namex/Documents,.... obwohl Dateien mit Archivbits gesetzt sind. Ich helfe mir damit, dass ich bei 2 Files, 1 im Pfad /Users/Namex und eine zweite in /Users/Namex/Documents mit dem Script jedesmal bewusst wieder das Archivbit setze für das nächste Sichern. Ich wäre dankbar für einen Hinweis, was der Grund sein könnte, dass er manchmal nichts sichert solange ich diese 2 Dateien nicht mit Archivbits versehe.
Das Script stammt übrigens von Buch Windows Scripting von Tobias Weltner.
'------------------------------------------------------------------------------------------------------------
' Incremental-Sicherung von C:\Users\Erwin nach Platte 1 E:\backup1
'------------------------------------------------------------------------------------------------------------
'
Set objshell = CreateObject(WScript.Shell)
Set IShellDispatch = CreateObject(Shell.Application)
Set objfs = CreateObject(Scripting.FileSystemObject)
Set objAusgabe = WScript.StdOut
Set wmi = GetObject(winmgmts://./root/cimv2)
Set objnet = CreateObject(WScript.Network)
'--User ermitteln----------------------------------------------------------
Benutzer = objnet.Username
intLang = Len(Benutzer)
'------------------------------------------------------------
' pruefen ob Laufwerk da ist --------------------------------
On Error Resume Next
'-ma---------------------------------------------------------------------------------------------------------
Set objDrive = objfs.GetDrive(E:\) -><--- Laufwerkbuchstabe der externen Platte
'-me---------------------------------------------------------------------------------------------------------
If Err.Number <> 0 Then
MsgBox Externe Platte nicht verfügbar ! Code & Err.Number & vbCrLf & Programm beendet. & vbCrLf & Externe Platte anschliessen und Programm neu starten.
WScript.Quit
Else
End If
'-ma---------------------------------------------------------------------------------------------------------
strPathOriginal = C:\Users\ & Benutzer
strPathKopie = objDrive.Driveletter & :\backup1
strPathOutlook = C:\Users\ & Benutzer & \Documents\Outlook-Dateien
strPathOutlookKopie = objDrive.Driveletter & :\backup1\Outlook
'-me---------------------------------------------------------------------------------------------------------
intKopiert = 0
intAktuell = 0
ergebnis =
ChangeToCScript
Set objStart = objfs.GetFolder(strPathOriginal)
objAusgabe.WriteLine
objAusgabe.WriteLine
objAusgabe.WriteLine W-Script: >backup.vbs< V3.0 Incremental-Sicherung Benutzerdaten -><--- Version
objAusgabe.WriteLine Autor:Erwin Wochner, Aug.2011
objAusgabe.WriteLine
objAusgabe.WriteLine ...Teil-Sicherung läuft...
objAusgabe.WriteLine
objAusgabe.WriteLine Sichern nach: & strPathKopie
'---- pruefen ob Ordner existieren, sonst anlegen (fuer direkte Sicherungen) -------------
Set objStart4 = objfs.GetFolder(strPathOutlook)
strZielOrdner4 = strPathOutlookKopie & Mid(objStart4.PATH, Len(strPathOutlook) + 1)
If Not objfs.FolderExists(strZielOrdner4) then
objfs.CreateFolder strZielOrdner4
objAusgabe.WriteLine Ordner & strZielOrdner4 & angelegt.
End If
t1 = Timer
'-----------------------------------------------
BackupFiles objStart -><===
t2 = Timer
objAusgabe.WriteLine
objAusgabe.WriteLine ...Sicherung fertig.
strVolOutlook = FormatNumber(objfs.GetFolder(strPathOutlook).Size / 1024^2, 1) & MB
strVol = FormatNumber(objfs.GetFolder(strPathOriginal).Size / 1024^2, 1) & MB
MsgBox intKopiert & Dateien neu gesichert, & intAktuell & waren aktuell. & vbCrLf &_
Zeit für die Sicherung: & FormatNumber((t2 - t1) / 60 ,1) & Minuten. & vbCrLf &_
Datenvolumen von & strPathOutlook & : & strVolOutlook & vbCrLf &_
ergebnis
'-----------------------------------------------------------------------------------------------
Sub BackupFiles(ByVal objOrdner)
strZielOrdner = strPathKopie & Mid(objOrdner.PATH, Len(strPathOriginal) + 1)
strOrigOrdner = strPathOriginal & Mid(objOrdner.PATH, Len(strPathOriginal) + 1)
If Not objfs.FolderExists(strZielOrdner) then
objfs.CreateFolder strZielOrdner
End If
For Each objDatei In objOrdner.files
strZiel = objfs.BuildPath(strZielOrdner, objDatei.name)
strOrig = objfs.BuildPath(strOrigOrdner, objDatei.name)
doCopy = False
If ((objDatei.Attributes And 32) = 32) Then
doCopy = True
ElseIf Not objfs.FileExists(strZiel) Then
doCopy = True
End If
If doCopy Then
On Error Resume Next
objDatei.Copy strZiel
If Err.Number = 0 Then
objDatei.Attributes = objDatei.Attributes And Not 32
intKopiert = intKopiert + 1
objAusgabe.WriteLine Gesichert wurde & strOrig
Else
ergebnis = ergebnis & Nicht gesichert & Err.Number & & strOrig & vbCrLf
objAusgabe.WriteLine Nicht gesichert & Err.Number & & strOrig
End If
'--- If Mid(strOrig,(20 + intLang),12) = \backup2.txt Then
'--- objDatei.Attributes = 32
'--- objAusgabe.WriteLine backup2.doc Archivbit wieder gesetzt. & strOrig
'--- End If
'---
'--- If Mid(strOrig,(10 + intLang),12) = \backup1.txt Then
'--- objDatei.Attributes = 32
'--- objAusgabe.WriteLine backup1.txt Archivbit wieder gesetzt. & strOrig
'--- End If
Else
intAktuell = intAktuell + 1
End If
Next
For Each objUnterordner In objOrdner.subfolders
BackupFiles objUnterordner
Next
End Sub
Sub ChangeToCScript
pos = InStrRev(WScript.FullName, \)
host = LCase(Mid(WScript.FullName, pos + 1))
If host <> cscript.exe Then
Set objShell = CreateObject(WScript.Shell)
objShell.Run cscript.exe & WScript.ScriptFullName &
WScript.Quit
End If
End Sub
ich habe folgendes VBScript seit Jahren unter WIN-XP problemlos in Verwendung. Unter Vista und Win7 tritt aber ein komischer Effekt auf. Manchmal tut das Script so, wie wenn es nichts zu sichern gäbe in den ganzen Dateibaum /Users/Namex/Documents,.... obwohl Dateien mit Archivbits gesetzt sind. Ich helfe mir damit, dass ich bei 2 Files, 1 im Pfad /Users/Namex und eine zweite in /Users/Namex/Documents mit dem Script jedesmal bewusst wieder das Archivbit setze für das nächste Sichern. Ich wäre dankbar für einen Hinweis, was der Grund sein könnte, dass er manchmal nichts sichert solange ich diese 2 Dateien nicht mit Archivbits versehe.
Das Script stammt übrigens von Buch Windows Scripting von Tobias Weltner.
'------------------------------------------------------------------------------------------------------------
' Incremental-Sicherung von C:\Users\Erwin nach Platte 1 E:\backup1
'------------------------------------------------------------------------------------------------------------
'
Set objshell = CreateObject(WScript.Shell)
Set IShellDispatch = CreateObject(Shell.Application)
Set objfs = CreateObject(Scripting.FileSystemObject)
Set objAusgabe = WScript.StdOut
Set wmi = GetObject(winmgmts://./root/cimv2)
Set objnet = CreateObject(WScript.Network)
'--User ermitteln----------------------------------------------------------
Benutzer = objnet.Username
intLang = Len(Benutzer)
'------------------------------------------------------------
' pruefen ob Laufwerk da ist --------------------------------
On Error Resume Next
'-ma---------------------------------------------------------------------------------------------------------
Set objDrive = objfs.GetDrive(E:\) -><--- Laufwerkbuchstabe der externen Platte
'-me---------------------------------------------------------------------------------------------------------
If Err.Number <> 0 Then
MsgBox Externe Platte nicht verfügbar ! Code & Err.Number & vbCrLf & Programm beendet. & vbCrLf & Externe Platte anschliessen und Programm neu starten.
WScript.Quit
Else
End If
'-ma---------------------------------------------------------------------------------------------------------
strPathOriginal = C:\Users\ & Benutzer
strPathKopie = objDrive.Driveletter & :\backup1
strPathOutlook = C:\Users\ & Benutzer & \Documents\Outlook-Dateien
strPathOutlookKopie = objDrive.Driveletter & :\backup1\Outlook
'-me---------------------------------------------------------------------------------------------------------
intKopiert = 0
intAktuell = 0
ergebnis =
ChangeToCScript
Set objStart = objfs.GetFolder(strPathOriginal)
objAusgabe.WriteLine
objAusgabe.WriteLine
objAusgabe.WriteLine W-Script: >backup.vbs< V3.0 Incremental-Sicherung Benutzerdaten -><--- Version
objAusgabe.WriteLine Autor:Erwin Wochner, Aug.2011
objAusgabe.WriteLine
objAusgabe.WriteLine ...Teil-Sicherung läuft...
objAusgabe.WriteLine
objAusgabe.WriteLine Sichern nach: & strPathKopie
'---- pruefen ob Ordner existieren, sonst anlegen (fuer direkte Sicherungen) -------------
Set objStart4 = objfs.GetFolder(strPathOutlook)
strZielOrdner4 = strPathOutlookKopie & Mid(objStart4.PATH, Len(strPathOutlook) + 1)
If Not objfs.FolderExists(strZielOrdner4) then
objfs.CreateFolder strZielOrdner4
objAusgabe.WriteLine Ordner & strZielOrdner4 & angelegt.
End If
t1 = Timer
'-----------------------------------------------
BackupFiles objStart -><===
t2 = Timer
objAusgabe.WriteLine
objAusgabe.WriteLine ...Sicherung fertig.
strVolOutlook = FormatNumber(objfs.GetFolder(strPathOutlook).Size / 1024^2, 1) & MB
strVol = FormatNumber(objfs.GetFolder(strPathOriginal).Size / 1024^2, 1) & MB
MsgBox intKopiert & Dateien neu gesichert, & intAktuell & waren aktuell. & vbCrLf &_
Zeit für die Sicherung: & FormatNumber((t2 - t1) / 60 ,1) & Minuten. & vbCrLf &_
Datenvolumen von & strPathOutlook & : & strVolOutlook & vbCrLf &_
ergebnis
'-----------------------------------------------------------------------------------------------
Sub BackupFiles(ByVal objOrdner)
strZielOrdner = strPathKopie & Mid(objOrdner.PATH, Len(strPathOriginal) + 1)
strOrigOrdner = strPathOriginal & Mid(objOrdner.PATH, Len(strPathOriginal) + 1)
If Not objfs.FolderExists(strZielOrdner) then
objfs.CreateFolder strZielOrdner
End If
For Each objDatei In objOrdner.files
strZiel = objfs.BuildPath(strZielOrdner, objDatei.name)
strOrig = objfs.BuildPath(strOrigOrdner, objDatei.name)
doCopy = False
If ((objDatei.Attributes And 32) = 32) Then
doCopy = True
ElseIf Not objfs.FileExists(strZiel) Then
doCopy = True
End If
If doCopy Then
On Error Resume Next
objDatei.Copy strZiel
If Err.Number = 0 Then
objDatei.Attributes = objDatei.Attributes And Not 32
intKopiert = intKopiert + 1
objAusgabe.WriteLine Gesichert wurde & strOrig
Else
ergebnis = ergebnis & Nicht gesichert & Err.Number & & strOrig & vbCrLf
objAusgabe.WriteLine Nicht gesichert & Err.Number & & strOrig
End If
'--- If Mid(strOrig,(20 + intLang),12) = \backup2.txt Then
'--- objDatei.Attributes = 32
'--- objAusgabe.WriteLine backup2.doc Archivbit wieder gesetzt. & strOrig
'--- End If
'---
'--- If Mid(strOrig,(10 + intLang),12) = \backup1.txt Then
'--- objDatei.Attributes = 32
'--- objAusgabe.WriteLine backup1.txt Archivbit wieder gesetzt. & strOrig
'--- End If
Else
intAktuell = intAktuell + 1
End If
Next
For Each objUnterordner In objOrdner.subfolders
BackupFiles objUnterordner
Next
End Sub
Sub ChangeToCScript
pos = InStrRev(WScript.FullName, \)
host = LCase(Mid(WScript.FullName, pos + 1))
If host <> cscript.exe Then
Set objShell = CreateObject(WScript.Shell)
objShell.Run cscript.exe & WScript.ScriptFullName &
WScript.Quit
End If
End Sub