Sub MoveArchiveFiles()
'alle Dateien von "\Storage Card SD\Archiv" nach "\\NetzPC\Archiv" verschieben
'Skript für Panel unter Windows CE - funktioniert nicht in Panel-Simulation auf PC (Abbruch bei CreateObject)
Dim fs, filename, sourcepath, destpath, sourcefilename, destfilename
sourcepath = "\Storage Card SD\Archiv"
destpath = "\\NetzPC\Archiv"
Set fs = CreateObject("FileCtl.FileSystem") 'wenn hier Runtime-Error, dann wird Skript mit Systemmeldung abgebrochen
'*** Ziel Netzwerk-Freigabe erreichbar? Evtl. keine Rechte? Der Check kann einige Sekunden dauern!
If fs.Dir(destpath) = "" Then
ShowSystemAlarm "Ziel '" & destpath & "' nicht erreichbar!"
Exit Sub 'Skript beenden, weiterführen nicht sinnvoll
End If
'*** Quellordner existiert? SD-Card gesteckt?
filename = fs.Dir(sourcepath)
If filename = "" Then
ShowSystemAlarm "Quellordner '" & sourcepath & "' nicht gefunden!"
Exit Sub 'Skript beenden, weiterführen nicht sinnvoll
End If
'? Weil ALLE Dateien verschoben werden sollen, muß Dir() nicht nochmal mit Dateinamen-Muster aufgerufen werden?
'! Prüfen, ob womöglich die Einträge "." und ".." geliefert werden, und was passiert dann beim Kill und FileCopy?
'! Prüfen, ob gefundene Einträge womöglich Ordner/Verzeichnisse sind! (fs.GetAttr)
'Ab hier können verschiedene Runtime-Errors auftreten, die besonders behandelt werden sollen
On Error Resume Next
'*** in Schleife jede gefundene Datei kopieren/archivieren und anschließend löschen
Do While filename <> "" 'And filename <> "." And filename <> ".." ?
destfilename = destpath & "\" & filename
sourcefilename = sourcepath & "\" & filename
'DEBUG: in Testphase jeden Dateiname ausgeben
' ShowSystemAlarm "Datei '" & sourcefilename & "' nach '" & destfilename & "' kopieren ..."
'FileCopy erzeugt Runtime-Error, wenn Zieldatei schon existiert
'deshalb wenn Zieldatei schon existiert, dann vor dem Kopieren löschen
If fs.Dir(destfilename) <> "" Then fs.Kill destfilename
'Datei kopieren
fs.FileCopy sourcefilename, destfilename
'ist evtl. bei Kill oder FileCopy ein Runtime-Error aufgetreten? Dann Meldung und Skript abbrechen
If Err.Number <> 0 Then
ShowSystemAlarm "Runtime-Error " & CStr(Err.Number) & " " & Err.Description & " beim Kopieren von '" & filename & "'"
Exit Sub 'Skript abbrechen, weiterführen nicht sinnvoll
End If
'wenn kein Fehler beim Kopieren, dann Quelldatei löschen
fs.Kill sourcefilename
If Err.Number <> 0 Then
ShowSystemAlarm "Runtime-Error " & CStr(Err.Number) & " " & Err.Description & " beim Löschen von '" & sourcefilename & "'"
Exit Sub 'Skript abbrechen, weiterführen nicht sinnvoll
End If
'weitere Datei vorhanden?
filename = fs.Dir()
Loop
'*** Erfolgs/Fertigmeldung
'If Err.Number <> 0 Then
ShowSystemAlarm "Dateien erfolgreich nach Netzwerk verschoben."
'End If
End Sub
