Hallo Fred
ich habe dank der Hilfe vom
@PN/DP das Skript gestern zum laufen bekommen.
Ich habe mir das soweit angepasst das es nur auf Win CE läuft. Ich werde wohl noch die Fehler merker aussortieren um das Skript kleiner zu machen.
Code:
Sub Kopieren()
' ####################################################################################################
' Kopiert den gegebenen Ordner in das gegebene Zielverzeichnis. Ein existierender Ordner wird ggf.
' überschrieben. Tritt während der Abarbeitung ein Fehler auf, so werden bereits kopierte Ordner-
' inhalte nicht gelöscht.
'
' HINWEIS: Bei Geräten mit WinCE führt die Existenz von Unterverzeichnissen im Quellordner zu einem
' Fehler!
'
' @param 'sourcePath' -> Pfad und Name des Quellordners als STRING
' @param 'destinationPath' -> Pfad und Name des Zielordners als STRING
' @param 'overwrite' -> Überschreibe einen bereits existierenden Ordner als BOOL (wird bei WinCE-Geräten nicht berücksichtigt)
'
'
' -------------------------------------------------------------------------------------------
' | Version | Autor | Änderung
' -------------------------------------------------------------------------------------------
' | 01_00_00_00 | fk | Neuerstellung
'
' ####################################################################################################
' ##################################################
' Variablenreferenzen holen, Funktion initialisieren
' ##################################################
Dim fso, fs
Dim firstLoop, fileName
Dim fctStatus
Dim UtilsFIO_doesFileExist
fctStatus = EId_NO_ERROR
On Error Resume Next
SmartTags("sourcePath")= SmartTags("UnterordnerTK1")
SmartTags("destinationPath")="\storage card usb"
UtilsFIO_doesFileExist = False
' ##############
' Funktionslogik
' ##############
Set fs = CreateObject("FileCtl.FileSystem")
If fs.dir(sourcePath) = "" Then
fctStatus = EId_FOLDER_DOES_NOT_EXIST
End If
If fctStatus = EId_NO_ERROR Then
If fs.Dir(destinationPath) = "" Then
fs.MkDir destinationPath
End If
If fs.Dir(destinationPath) = "" Then
fctStatus = EId_FOLDER_DOES_NOT_EXIST
End If
End If
If fctStatus = EId_NO_ERROR Then
firstLoop = True
Do
If firstLoop Then
fileName = fs.Dir(sourcePath & "\*.*")
firstLoop = False
Else
fileName = fs.Dir
End If
If fileName <> "" Then
If UtilsFIO_doesFileExist(destinationPath & "\" & fileName) Then
fs.kill destinationPath & "\" & fileName
End If
fs.FileCopy (sourcePath & "\" & fileName), (destinationPath & "\" & fileName)
fctStatus = Err.Number
ShowSystemAlarm sourcePath & "\" & fileName
ShowSystemAlarm destinationPath & "\" & fileName
If fctStatus > EId_NO_ERROR Then
Exit Do
End If
Else
Exit Do
End If
Loop
End If
' ################
' Funktionsausgang
' ################
' Funktionsstatus global bekanntmachen
SmartTags("fctStatus_global") = fctStatus
ShowSystemAlarm "8"
Set fs = Nothing
Set fso = Nothing
Err.Clear
On Error GoTo 0
End Sub
Momentan kopiert der mit beliebig viele csv Dateien die in einem Ordner sind direkt auf einen USB Stick.
Ich benötige aber noch etwas mehr.
Ich habe verschiedene Ordner auf der \Storage card SD in denen sich die CSV Dateien befinden.
Schön wäre wenn ich die Ordner mit kopieren könnte.
Beispiel:
\storage card SD\Trockner1\Charge1\Daten1.csv --> \storage card USB\Trockner1\Charge1\Daten1.csv
\storage card SD\Trockner1\Charge1\Daten2.csv --> \storage card USB\Trockner1\Charge1\Daten2.csv
\storage card SD\Trockner1\Charge2\Daten1.csv --> \storage card USB\Trockner1\Charge2\Daten1.csv
\storage card SD\Trockner1\Charge2\Daten2.csv --> \storage card USB\Trockner1\Charge2\Daten2.csv
\storage card SD\Trockner2\Charge4\Daten1.csv --> \storage card USB\Trockner2\Charge4\Daten1.csv
\storage card SD\Trockner2\Charge4\Daten2.csv --> \storage card USB\Trockner2\Charge4\Daten2.csv
Ich werde die tage mal versuchen das Skript zu erweitern
oder gibt es da schon was fertiges?
Danke für eure unterstützung
Stephan
