Dim PathSearch, Path, Index, Result, fso, SourceFile, DestFile, f, fs, Header, StartTime, StopTime, DelayTime, i, Zeile(10000)
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
'--------------------------
If SmartTags("Status_kopieren") = 50 Then
Path = "\\LAPTOP_WO\Logs\WriteAccess.ok"
StartTime = Now
DelayTime = 500 'Timer 100 endspricht 1sec.
StopTime = StartTime + DelayTime / 24 / 360000
Do
Result = Ziel_pruefen (Path)
If Result = "WriteAccess.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 abfragen
'---------------------
If SmartTags("Status_kopieren") = 70 Then
Set f = CreateObject("FileCtl.File")
Set fs = CreateObject("FileCtl.FileSystem")
Path = "\\LAPTOP_WO\Logs\Data.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"
StartTime = Now
DelayTime = 1000 'Timer 100 endspricht 1sec.
StopTime = StartTime + DelayTime / 24 / 360000
Do
Result = Ziel_pruefen (Path)
If Result = "Data.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
' Datei öffnen bzw. erstellen, wenn sie noch nicht existiert
' Open File or create file if it does not exist
f.open Path, 8
' Tabellenkopf zusammenstellen
' Create table header
Header = "Storage time;Barcode;Wert" & Chr(10)
' Wenn Datei 0 Byte groß, dann ist sie neu
' If file is 0 byte the file is new
If fs.FileLen(Path) = 0 Then
f.lineprint(Header)
' =0 => Tabellenkopf muss eingefügt werden
End If
' Datei wieder schließen
f.Close
'90: letzten Eintrag suchen
'--------------------------
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 10000
If f.EOF = True Then Exit For
Zeile(i) = f.LineInputString
SmartTags("tmpZeile") = Zeile(i)
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
' Create FileObject
Set f = CreateObject("FileCtl.File")
' Datei öffnen im Append-Modus
f.open "\\LAPTOP_WO\Logs\Data.csv", 8
For i = 1 To 10000
f.lineprint Zeile(i+1)
If Zeile(i) = SmartTags("tmpZeile") Then Exit For
Next
' 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 = Nothing