OP
Tigerente1974
Level-3
- Beiträge
- 1.826
- Reaktionspunkte
- 293
-> Hier kostenlos registrieren
Abschließend stelle ich jetzt mein Ergebnis rein. Vielleicht hilft es nochmal jemandem...
1. Archivdatei auf dem Stick anlegen.
2. Daten vom Stick auf den Server kopieren
Dazu wird die Quelldatei Zeile für Zeile ausgelesen und im Append-Modus auf die Zieldatei geschrieben.
Schreibfreigabe und Vorhandensein der Dateien werden geprüft.
Es werden noch die Sub-Routine "Ordernpfad_anlegen" und die Funktion "Ziel_prüfen" verwendet.
Ordnerpfad anlegen:
Ziel_pruefen:
1. Archivdatei auf dem Stick anlegen.
Code:
Dim fs, f, FName, Header, strDir
' FileSystemObject erstellen
' Create FileSystemObject
Set fs = CreateObject("FileCtl.FileSystem")
' Prüfen ob USB-Stick vorhanden ist
' Checking if USB-device available
strDir = fs.dir ("\Storage Card USB\")
If strDir = "" Then 'Ablagepfad nicht vorhanden / directory not exists, card not available
Call ShowSystemAlarm ("Kein USB-Stick vorhanden / No USB-device available")
Else
' Archivierungspfad (Eingangsparameter) und Dateiname zusammensetzen
' Combine archivepath (input parameter) and filename
FName = StoragePath & "\PAL_ID_" & CStr(DatePart("m",Date)) & "_" & CStr(DatePart("yyyy",Date)) & ".csv"
' Tabellenkopf zusammenstellen
' Create table header
Header = "Zeitstempel;Barcode;Hoehe" & Chr(10)
' FileObject erstellen
' Create FileObject
Set f = CreateObject("FileCtl.File")
'Prüfen ob Ablagepfad vorhanden, wenn nicht -> erzeugen.
'Checks storage path availably, if not -> create
Ordnerpfad_anlegen StoragePath ' Übergabe des Ablagepfades aus dem Script "Script_Storage_Path" / Handing over of the storage path from the script "Script_Storage_Path"
' Datei öffnen bzw. erstellen, wenn sie noch nicht existiert
' Open File or create file if it does not exist
f.open FName, 8
' Werte der Variablen in die Archivdatei schreiben (VAR_1)
' Write values of variables in archive file (VAR1)
f.lineprint(CStr(Now) & ";" & CStr(SmartTags("PAL_ID")) & ";" & CStr(SmartTags("Hoehe")))
' Datei wieder schließen
' Close file
f.Close
End If
' Verwendeten Speicher wieder freigeben
' Used storage will be freed
Set f = Nothing
Set fs = Nothing2. Daten vom Stick auf den Server kopieren
Dazu wird die Quelldatei Zeile für Zeile ausgelesen und im Append-Modus auf die Zieldatei geschrieben.
Schreibfreigabe und Vorhandensein der Dateien werden geprüft.
Code:
Dim PathSearch, Path, Index, Result, fso, SourceFile, DestFile, f, fs, Header, StartTime, StopTime, DelayTime, i, Laenge, fileContent
Set PathSearch = CreateObject("FileCtl.FileSystem")
'USB-Stick suchen
'--------------------
Path = "Storage Card USB"
SetValue SmartTags("Status_kopieren"), 10 'Text: Suche USB-Stick
StartTime = Now
DelayTime = 500 'Timer 100 endspricht 1sec.
StopTime = StartTime + DelayTime / 24 / 360000
Do
If PathSearch.Dir("\" & Path) = ""_
And Now >= StopTime Then
SetValue SmartTags("Status_kopieren"), 20 'Text: USB-Stick nicht gefunden!
ElseIf PathSearch.Dir("\" & Path) = Path Then
SetValue SmartTags("Status_kopieren"), 30 'Text: Suche Zielordner
End If
Loop Until Now >= StopTime
'30: Ziellaufwerk suchen
'-----------------------
If SmartTags("Status_kopieren") = 30 Then
Path = "\\LAPTOP_WO\Logs\"
StartTime = Now
DelayTime = 500 'Timer 100 endspricht 1sec.
StopTime = StartTime + DelayTime / 24 / 360000
Do
Result = Ziel_pruefen (Path)
If Result = "Logs" Then
SetValue SmartTags("Status_kopieren"), 50 'Text: Schreibfreigabe prüfen
ElseIf Now >= StopTime Then
SetValue SmartTags("Status_kopieren"), 40 'Text: Zielordner nicht gefunden
End If
Loop Until Now >= StopTime
End If
'50: Schreibfreigabe prüfen
'--------------------------
' Die Datei "Write_Access.ok" muss im Zielordner vorhanden sein.
If SmartTags("Status_kopieren") = 50 Then
Path = "\\LAPTOP_WO\Logs\Write_Access.ok"
StartTime = Now
DelayTime = 500 'Timer 100 endspricht 1sec.
StopTime = StartTime + DelayTime / 24 / 360000
Do
Result = Ziel_pruefen (Path)
If Result = "Write_Access.ok" Then
SetValue SmartTags("Status_kopieren"), 70 'Text: Zieldatei suchen
ElseIf Now >= StopTime Then
SetValue SmartTags("Status_kopieren"), 60 'Text: keine Schreibfreigabe
End If
Loop Until Now >= StopTime
End If
'70: Zieldatei prüfen
'---------------------
If SmartTags("Status_kopieren") = 70 Then
Set f = CreateObject("FileCtl.File")
Set fs = CreateObject("FileCtl.FileSystem")
Path = "\\LAPTOP_WO\Logs\Archiv.csv"
'Prüfen ob Ablagepfad vorhanden, wenn nicht -> erzeugen.
Ordnerpfad_anlegen Path ' Übergabe des Ablagepfades aus dem Script "Script_Storage_Path" / Handing over of the storage path from the script "Script_Storage_Path"
' Datei öffnen bzw. erstellen, wenn sie noch nicht existiert
f.open Path, 8
' Tabellenkopf zusammenstellen
Header = "Zeitstempel;Barcode;Hoehe" & Chr(10)
' Wenn Datei 0 Byte groß, dann ist sie neu
If fs.FileLen(Path) = 0 Then
f.lineprint(Header)
'=0 => Tabellenkopf muss eingefügt werden
End If
' Datei wieder schließen
f.Close
StartTime = Now
DelayTime = 1000 'Timer 100 endspricht 1sec.
StopTime = StartTime + DelayTime / 24 / 360000
Do
Result = Ziel_pruefen (Path)
If Result = "Archiv.csv" Then
SetValue SmartTags("Status_kopieren"), 90 'Text: Einträge kopieren
ElseIf Now >= StopTime Then
SetValue SmartTags("Status_kopieren"), 80 'Text: Datei nicht gefunden
End If
Loop Until Now >= StopTime
End If
'90: Datei suchen und auslesen
'-----------------------------
If SmartTags("Status_kopieren") = 90 Then
Set fso = CreateObject("FileCtl.FileSystem")
SmartTags("Name") = fso.Dir("\Storage Card USB\*.csv") 'Suchen nach ersten Dateiname auf Stick
f.open("\Storage Card USB\" & SmartTags("Name")),1,1
For i = 1 To 1000000
If f.EOF = True Then Exit For
fileContent = fileContent & f.LineInputString & vbCrLf
'Leerzeile am Ende löschen
Laenge = Len (fileContent - 2)
fileContent = Left(fileContent,Laenge)
Next
' Datei wieder schließen
f.Close
SetValue SmartTags("Status_kopieren"), 100
End If
'100: Einträge im Appendmodus anhängen
'-------------------------------------
If SmartTags("Status_kopieren") = 100 Then
' FileObject erstellen
Set f = CreateObject("FileCtl.File")
' Datei öffnen im Append-Modus
f.open "\\LAPTOP_WO\Logs\Archiv.csv", 8
' Einträge anhängen
f.lineprint fileContent
' Datei wieder schließen
f.Close
SetValue SmartTags("Status_kopieren"), 110
End If
'110: Quelldatei löschen
'-----------------------
If SmartTags("Status_kopieren") = 110 Then
fs.Kill ("\Storage Card USB\" & SmartTags("Name"))
SetValue SmartTags("Status_kopieren"), 200
End If
' Verwendeten Speicher wieder freigeben
Set f = Nothing
Set fs = Nothing
Set fso = Nothing
Set PathSearch = NothingEs werden noch die Sub-Routine "Ordernpfad_anlegen" und die Funktion "Ziel_prüfen" verwendet.
Ordnerpfad anlegen:
Code:
'Hinweis/Note:
'Wenn der vorgegebene Ablagepfad im "Hauptscript" mehrere Unterordner enthält,
'müssen diese Unterordner auf der Speicherkate komplett vorhanden sein.
'Dieses Script dient dazu, dieses automatisch umzusetzen.
'If the predefined storage path includes several sub-folders in the "Main script",
'the path of the sub-folders must already be completely available on the memory card .
'This script serves to convert this automatically.
Dim fs, strDir, strTemp, arr
' FileSystemObject erstellen
' Create FileSystemObject
Set fs = CreateObject("FileCtl.FileSystem")
strTemp = "" ' Hilfsvariable / Help tag
arr = Split (strPath, "\") ' Ablagepfad in einzelen "\" zerlegen / split the Storage path in several "\"
For Each strDir In arr ' Schleifenzähler / loop counter
If Len(strDir) > 0 Then
strTemp = strTemp + "\" + strDir
strDir = fs.dir (strTemp)
If strDir = "" Then ' Wenn kein "\" mehr vorhanden ist -> keine weiteren Unterpfade / If no "\" existing, then no further sub-folders
fs.mkDir strTemp
End If
End If
Next
Set fs = NothingZiel_pruefen:
Code:
Dim fso
Set fso = CreateObject("FileCtl.FileSystem")
Ziel_pruefen = fso.Dir(Ziel)
Zuletzt bearbeitet:
