Skript um Dateien samt Ordnerstruktur über SendTo zu verschieben

S:\
?? Archiv
??? Abteilung 1
???? Subdir 1
????? Subdir 1a
???? Subdir 2
???? ...
??
??? Abteilung 2
???? ...
??
??? Abteilung 3
? ?? ...
?
?? Abteilung 1
??? Subdir 1
???? Subdir 1a
??? Subdir 2
??? ...
?
?? Abteilung 2
??? ...
?
?? Abteilung 3
 ?? ...

'==========================================================================  
'  
' NAME: Dateien archivieren  
' VERSION: 0001  
'  
' AUTOR: Christian Voigt-Sommer  
' DATUM: 14.09.2007  
'  
' Funktion:   
'   
'==========================================================================  
' Änderungen:   
'   
'==========================================================================  

Option Explicit

DIM fso
DIM args
DIM tmp
DIM strQuelle
DIM strQuellPfad
DIM strZielPfad
DIM strArchivPfad

strArchivPfad="D:\TEMP\"  

sChkCScript()

Set fso = CreateObject("Scripting.FileSystemObject")  

Set args=WScript.Arguments
If args.Count>0 Then
   strQuelle=args(0)
   tmp = InStrRev(strQuelle,"\")  
   strQuellPfad = Left(args(0),tmp)
Else
   sSay "Archiviert Dateien in einem vordefiniertem Ordner"  
   sSay "unter Beibehaltung der Ordnerstuktur"  
   sSay ""  
   sSay "Um eine Datei zu verschieben:"  
   sSay "Archiv.vbs [Laufwerk:][Pfad]Datei"  
   sSay ""  
   sSay "Um ein Verzeichniss zu verschieben:"  
   sSay "Archiv.vbs [Laufwerk:][Pfad]Verz"  
   sSay ""  
   sSay "[Laufwerk:][Pfad]Datei   Bezeichnet den Pfad und den Namen der zu"  
   sSay "                         archivierenden Datei(en)."  
   sSay "[Laufwerk:][Pfad]Verz    Bezeichnet das zu archivierende Verzeichnis."  
   sSay ""  
   WScript.Sleep 60*5
   WScript.Quit
End If

strZielPfad=strArchivPfad & mid(strQuellPfad,4,500)

sSay "strArchivPfad: " & strArchivPfad  
sSay "strQuelle: " & strQuelle  
sSay "strQuellPfad: " & strQuellPfad  

sSay ""  
sSay "md " & strZielPfad  
fAusfuehren "cmd.exe /c md " & strZielPfad,"Msg",""  
sSay ""  
sSay "move " & strQuelle & " " & strZielPfad  
fAusfuehren "cmd.exe /c move " & strQuelle & " " & strZielPfad,"Msg",""  

   WScript.Sleep 60*50

'###########################################################################################  
'                                 Beginn Sub und Function  
'###########################################################################################  

'##### Beginn ASCII2ANSI #####  
' Wandelt deutsche Zeichen (Umlaute) um  
Function fASCII2ANSI(text)
Dim temp
	temp = Replace(text, Chr(132), Chr(228))
	temp = Replace(temp, Chr(129), Chr(252))
	temp = Replace(temp, Chr(142), Chr(196))
	temp = Replace(temp, Chr(154), Chr(220))
	temp = Replace(temp, Chr(153), Chr(214))
	temp = Replace(temp, Chr(148), Chr(246))
	temp = Replace(temp, Chr(225), Chr(223))
	fASCII2ANSI = temp
End Function
'##### Ende ASCII2ANSI #####  

 '##### Beginn Ausfuehren #####  
' Ausführen von Programmen oder Betriebssystem-Befehlen  
Function fAusfuehren(strBefehl,strArt,strLogFile)
  Dim objWshShell
  Dim objJob
  Dim strJobErr
  Dim rc
  Dim TMP

  strJobErr = ""  
  Set objWshShell = WScript.CreateObject("Wscript.shell")  
  Set objJob = objWshShell.Exec(strBefehl)

  Do While objJob.status = 0
    TMP = objJob.stderr.readall
    If TMP <> "" Then  
      strJobErr = strJobErr & fASCII2ANSI(TMP)
    End If
  Loop
  rc = objJob.ExitCode

  If strArt="Log" Then  
    If rc <> 0 Then
      sWriteLog strLogFile,"""" & strBefehl & """ (RC: " & rc & ")" & vbCRLF & strJobErr  
    Else
      sWriteLog strLogFile,"Aktion """ & strBefehl & """ erfolgreich abgeschlossen (RC: " & rc & ")"  
    End If
  ElseIf strArt="Msg" Then  
    If rc <> 0 Then
      sSay strBefehl & "(RC: " & rc & ")" & vbCRLF & strJobErr  
    Else
      sSay strBefehl & " erfolgreich abgeschlossen (RC: " & rc & ")"  
    End If 
  End If

  If rc <> 0 Then
    fAusfuehren = rc
  Else
    fAusfuehren = 0
  End If
End Function
'##### Ende Ausfuehren #####  

 '##### Beginn LeftString #####  
' sucht das letzte Zeichen in einem String und gibt alles vor dem Zeichen aus  
Function fLeftString(String,Trennzeichen)
On Error Resume Next
      fLeftString = Left(String,InStrRev(String,Trennzeichen)-1)
On Error Goto 0
End Function
'##### Ende LeftString #####  

 '##### Beginn ChkCScript #####  
' Prüfung, ob Ausführung über CScript.exe  
Sub sChkCScript()
If Not InStr(UCase(WScript.FullName), "CSCRIPT") <> 0 Then  
   MsgBox "Ausführung mit CScript erforderlich!"  
   WScript.Quit
End If
End Sub
'##### Ende ChkCScript #####  

 '##### Beginn Say #####  
' Bildschirmausgabe  
Sub sSay(Msg)
 Wscript.echo Msg
End Sub
'##### Ende Say #####