ResourceCopy

Dieses Script ist mir in meinem derzeitigen Projekt in Hamburg sehr nützlich.
Nachdem mir in den ersten Tagen Kopiervorgänge in das Netzwerk mehrfach abgebrochen sind, und ich dann also immer wieder von vorne beginnen musste, habe ich mich an robocopy erinnert.

Dank einiger toller Scripte von Dieseyer und aus dem Source-Center, die zwar für einen anderen Zweck gedacht waren, ging die Arbeit natürlich etwas leichter von statten.

Zunächst wird vorausgesetzt, dass wenn von Laufwerk C: kopiert werden soll, in einen vorbestimmten Zielordner kopiert wird. Ist die Quelle nicht auf dem C: - Laufwerk, erscheint ein Auswahldialog für den Zielordner.

Im nächsten Schritt wird der Speicherort von robocopy abgefragt und in die Registry geschrieben. Ist dieser Wert einmal vorhanden, dann erscheint dieser Dialog auch nicht mehr.

Als Goodie gibt es dann noch einen Link im SendTo, also im Kontextmenü.

Das Script erwartet einen Parameter zur Laufzeit. Wird es per Doppelklick gestartet, gibt es eine Fehlermeldung.

Also beim ersten Start einfach den Quellordner auf das VBS-Script ziehen. Danach über "Senden an".

Viel Spass damit.

'Automatisierter RessourcenCopy nach z:'
' oder ... wohin Du willst...'
'Es werden nur Verzeichnisse kopiert, bei Dateiangaben geht's gegen die Wand'
'Genutzt wird dabei robocopy.exe'

'SYNTAX : copy_nach_interne_qs.vbs [pfad...]Verzeichnisname'

'(c) 20.6.06 D.Blumenthal'

Option explicit
'On Error Resume Next

'Variablen referenzieren'
dim WshShell, WSHNetwork, oArgs, FSO, destpath, sargs, sargs2, rc,name
dim sendto, oShellLink, regkey, Wert, Fehler

public ToolPath

'Initialisierung, ist ein Startparameter angegeben worden ?'
set oArgs=wscript.Arguments

if oArgs.Count <1 then
wscript.echo VBCRLF & "! FEHLER !" & VBCRLF & "! Fehlender Parameter !"
wscript.quit
End if

'Objekte werden initialisiert'
set FSO = CreateObject("Scripting.FileSystemObject")
set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")

sArgs=fso.getfolder(oArgs(0))

'Soll von C: kopiert werden ?'
'Wenn ja, dann nimm das Z-LW als Ziel'
'Kann auch dahingehend angepasst werden, dass generell abgefragt wird'

rc=left(oargs(0),1)
if rc ="D" then
destpath = "Z:\2_Paketierung21\_interne_QS"
else
folderauswahl
end if

 

RegKey="HKEY_CURRENT_USERSoftwareDataportCopyTooltoolpath"
CheckRegKey(RegKey)
verifylnk()
toolrun()


'******************************************************************************'
'Beginn der Subroutinen'
'******************************************************************************'

'******************************************************************************'
'Neue Funktion
'Abfrage nach RegKey, ob der Speicherort von Robocopy ausgewählt wurde'
'Noch nicht ganz glücklich, da ich hier den gleichen Code nutze wie unter SUB Folderauswahl'

 


Function CheckRegKey(CheckKey)

On Error Resume Next
Wert=wshshell.RegRead(CheckKey)
Fehler=Err
'wscript.echo fehler

if not fehler="0" then

Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Const OverWriteFiles = True
dim objShell : Set objShell = CreateObject("Shell.Application")
dim objFolder : Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, "Wo Liegt Robocopy ?", NO_OPTIONS, "C: d:")
dim objFolderItem : Set objFolderItem = objFolder.Self
toolpath = objFolderItem.Path & "robocopy.exe"

if fso.fileexists (toolpath) then
wshshell.regwrite "HKCUSOFTWARE"
wshshell.regwrite "HKCUSOFTWARECopyTool"
wshshell.regwrite "HKCUSoftwareCopyTooltoolpath",toolpath,"REG_SZ"
else
wscript.echo VBCRLF & "! FEHLER !" & VBCRLF & "! Robocopy nicht gefunden !"
wscript.quit
end if
else

toolpath = wshshell.regread ("HKCUSoftwareCopyTooltoolpath")

end if

Err.Clear
On Error Goto 0
CheckRegKey=Fehler=0
End Function
'******************************************************************************'

 

 

Sub FolderAuswahl
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Const OverWriteFiles = True
dim objShell : Set objShell = CreateObject("Shell.Application")
dim objFolder : Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, "Zielordner auswählen:", NO_OPTIONS, "C: d:")
dim objFolderItem : Set objFolderItem = objFolder.Self
destPath = objFolderItem.Path & ""
End Sub

 

sub verifylnk()
'setzen der Verknpfung im Sendto-Ordner'
sendto = wshshell.specialfolders("Sendto")

if not fso.fileexists(sendto& "interne QS.lnk") then
set oShellLink = WshShell.CreateShortcut(sendto & "interne QS.lnk")
oShellLink.TargetPath = WScript.ScriptFullName
oShellLink.WindowStyle = 1
oShellLink.IconLocation = "notepad.exe, 0"
oShellLink.Description = "Schnelles Kopieren"
oShellLink.WorkingDirectory = "C:\Temp"
oShellLink.Save
end if
end sub

sub toolrun()
'Daten aus- und verwerten'
name = split(sargs, "", -1)
sargs2 = ubound(name)

if not fso.folderexists (destpath&name(sargs2)) then
fso.createfolder (destpath&name(sargs2))
end if

'Alles zusammen gesammelt und nu kanns losgehen mit die Kopiererei :-)'
'Der erfahrene Benutzer sieht, hier wird die eigentliche Arbeit gemacht'
'wscript.echo "cmd.exe /c " & "" & toolpath & "" & " /e /np /eta " & """" & sargs & """" & " "& """" &destpath&name(sargs2)& """" & " >"& """" & destpath&name(sargs2)& """" &"copylog.log"
rc=WshShell.run("cmd.exe /c " & "" & toolpath & "" & " /e /np /eta " & """" & sargs & """" & " "& """" &destpath&name(sargs2)& """" & " >"& """" & destpath&name(sargs2)& """" &"copylog.log",2,true)
rc = msgbox ("Kopieren von " & name(sargs2) & " beendet." &vblf & "Das Log wird zur Kontrolle geoeffnet ... ",65,"Kontrolle")
if rc=1 then WshShell.run("notepad.exe " & destpath&name(sargs2)&"copylog.log",1,true)
end sub

 


set WshShell=Nothing
set oArgs=Nothing
set FSO=Nothing

  • Donnerstag, 15 März 2018

Leave a comment

You are commenting as guest.