Zuviel Werbung? - > Hier kostenlos beim SPS-Forum registrieren

Seite 3 von 5 ErsteErste 12345 LetzteLetzte
Ergebnis 21 bis 30 von 44

Thema: Archivierung per skript

  1. #21
    Tigerente1974 ist offline Erfahrener Benutzer
    Themenstarter
    Registriert seit
    06.10.2009
    Ort
    NRW
    Beiträge
    1.572
    Danke
    63
    Erhielt 259 Danke für 219 Beiträge

    Standard


    Zuviel Werbung?
    -> Hier kostenlos registrieren
    Abschließend stelle ich jetzt mein Ergebnis rein. Vielleicht hilft es nochmal jemandem...

    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 = Nothing
    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.

    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 = Nothing
    Es 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 = Nothing
    Ziel_pruefen:

    Code:
    Dim fso
      Set fso = CreateObject("FileCtl.FileSystem")
      Ziel_pruefen = fso.Dir(Ziel)
    Geändert von Tigerente1974 (26.09.2013 um 05:58 Uhr)
    Meine Motivation läuft nackig mit einem Cocktail über eine Wiese.

  2. Folgende 2 Benutzer sagen Danke zu Tigerente1974 für den nützlichen Beitrag:

    Larzerus (27.09.2013),PN/DP (26.09.2013)

  3. #22
    Registriert seit
    17.10.2007
    Beiträge
    263
    Danke
    5
    Erhielt 52 Danke für 48 Beiträge

    Standard

    Zitat Zitat von Tigerente1974 Beitrag anzeigen
    Vielleicht noch eine letzte Frage.
    Ich lasse meine Schleife jetzt bis 1000000 laufen. Das wird sicher reichen. Ist aber auch nicht ganz sauber ausprogrammiert.
    Gibt es eine Möglichkeit, das sauber zu programmieren?
    Ach ja. Warum muss ich eigentlich "2" abziehen, um die Leerzeile zu löschen?
    Guten Morgen,

    zu deiner ersten Frage: ich würde eine Do...Loop-Schleife o.ä. verwenden, da du den Index 'i' ja nicht weiter benötigst/verwendest. Eine Abbruchbedingung hast du ja bereits jetzt integriert (If f.EOF...).
    Zu deiner zweiten Frage: Ein Zeilenumbruch stellt sich unter Windows als die beiden Zeichen Chr(13) für CarriageReturn und Chr(10) für LineFeed dar.


    Gruß, Fred

  4. Folgender Benutzer sagt Danke zu faust für den nützlichen Beitrag:

    Tigerente1974 (26.09.2013)

  5. #23
    Tigerente1974 ist offline Erfahrener Benutzer
    Themenstarter
    Registriert seit
    06.10.2009
    Ort
    NRW
    Beiträge
    1.572
    Danke
    63
    Erhielt 259 Danke für 219 Beiträge

    Standard

    Jetzt habe ich quasi bei 0 angefangen und bin an 2 Wochenenden zum Ziel gekommen.

    Toll, dass es dieses Forum gibt!
    Meine Motivation läuft nackig mit einem Cocktail über eine Wiese.

  6. #24
    Registriert seit
    22.06.2009
    Ort
    Sassnitz
    Beiträge
    11.204
    Danke
    926
    Erhielt 3.293 Danke für 2.662 Beiträge

    Standard

    Zitat Zitat von Tigerente1974 Beitrag anzeigen
    Abschließend stelle ich jetzt mein Ergebnis rein. Vielleicht hilft es nochmal jemandem...
    Zunächst: Ein schönes Stück Arbeit - viele Programmierer kommen gar nicht so weit...

    Natürlich gibt es da noch Sachen, die man verbessern kann:

    1. Skriptnamen

    Schreibe doch bitte in den Skripten als erste Zeile den (exakt geschriebenen!) Name der Sub/Function als Kommentar, wie z.B. hier
    Code:
    ' Sub SettingsIniSpeichern()
    Code:
    ' Function FolderExist(Path) prüft, ob ein angegebener Ordner existiert

    2. In Deinem 2. Skript: Deine eigentlich gut gemeinten Timeout-Schleifen sind "unglücklich" gebaut und unnötig.

    Auch wenn die gewünschte Operation erfolgreich war, so wird sie trotzdem 5 Sekunden lang wiederholt, ehe die Timeout-Schleife verlassen wird. Da fehlt "Exit Do". (Oder baue die Schleife anders: die gewünschte Operation in die Loop-Abbruchbedingung und den Timeout in den "Notausgang" Exit Do)
    Code:
        Do                        
            Result = Ziel_pruefen (Path)
            If  Result = "Logs" Then
                SetValue SmartTags("Status_kopieren"), 50            'Text: Schreibfreigabe prüfen
                Exit Do
            ElseIf Now >= StopTime Then    
                SetValue SmartTags("Status_kopieren"), 40            'Text: Zielordner nicht gefunden
            End If
        Loop Until Now >= StopTime
    Alle Deiner Zwangs-Warteschleifen (bzw. gewollte Timeout-Schleifen) sind aus meiner Sicht unnötig.
    Z.B. die erste 5s-Warteschleife zum Suchen des USB-Sticks: Ein USB-Stick ist angeschlossen oder nicht, er taucht nicht innerhalb von 5s doch noch auf ...

    Bei den meisten Funktionen ist es unerheblich, ob man sie einmal oder 5s lang immer wieder aufruft - wenn der erste Aufruf einen Fehler meldet, dann wird höchstwahrscheinlich auch der 1000. Aufruf den Fehler melden.
    Es gibt echt sehr wenig Funktionen wo es sinnvoll ist, diese wiederholt aufzurufen. Da fällt mir gerade nur ein Beispiel ein: das Suchen einer entfernten Netzwerkressource, wo eventuell erst ein VPN-Kanal aufgebaut wird oder ein Computer aufgeweckt werden muß.

    Funktionen wo ein Timeout sinnvoll ist haben meist einen eigenen Timeout und kommen sowieso nicht eher zum Skript zurück.


    3. Variablen lesen von SPS in RT

    Wenn Dein Skript dann nicht mehr die unnötigen langen Warteschleifen hat, dann wirst Du wahrscheinlich auf ein neues noch unentdecktes Problem stossen: Wie ist sichergestellt, daß die RT die aktuellen Werte Deiner zu archivierenden Variablen vor dem Schreiben in die Datei auch aus der SPS gelesen hat?
    Zu diesem Thema schaue mal hier (Link zu einem Codebeispiel) und benutze die Forumssuche nach GetDataRecordTagsFromPLC



    4. PS:
    Zitat Zitat von Tigerente1974 Beitrag anzeigen
    Jetzt habe ich quasi bei 0 angefangen und bin an 2 Wochenenden zum Ziel gekommen.
    Ich kann mir sehr gut vorstellen, daß viele heute übliche Software genau in dem Stadium vergleichbar mit Deinem Entwicklungsstand ist. Die Programmierer sind bestimmt "stolz wie Hubatz" über ihre Software (weil die ohne sichtbare Fehlermeldungen irgendwann zu einem Ende kommt) und ahnen gar nicht, was für unsicheren Dreck sie da programmiert haben. Da wird nur aufwendig an bunten Animationen gefeilt statt die eigentliche Funktion kritisch zu überprüfen.

    Also Tigerente1974: Du bist in professioneller Gesellschaft

    Für Deinen Willen, das Ergebnis Deiner Arbeit auch anderen zur Verfügung zu stellen, gebe ich Dir aber trotzdem ein DANKE.

    Harald
    Es ist immer wieder überraschend, wie etwas plötzlich funktioniert, sobald man alles richtig macht.

    FAQ: Linkliste SIMATIC-Kommunikation über Ethernet

  7. Folgender Benutzer sagt Danke zu PN/DP für den nützlichen Beitrag:

    Tigerente1974 (28.09.2013)

  8. #25
    Registriert seit
    22.06.2009
    Ort
    Sassnitz
    Beiträge
    11.204
    Danke
    926
    Erhielt 3.293 Danke für 2.662 Beiträge

    Standard

    Übrigens:
    Um SmartTags einen Wert zuzuweisen oder den Wert zu lesen ist es nicht nötig, die Funktionen SetValue und GetValue zu benutzen. Man kann direkt das SmartTag-Objekt verwenden - das liest sich oft besser:
    Code:
    Dim scriptVar
    
    scriptVar = SmartTags("Tag_1")
    SmartTags("Tag_2") = scriptVar
    SmartTags("Tag_3") = 50
    SmartTags("Tag_4") = "Alles OK"
    SmartTags("Tag_5") = SmartTags("Tag_3")
    Harald
    Es ist immer wieder überraschend, wie etwas plötzlich funktioniert, sobald man alles richtig macht.

    FAQ: Linkliste SIMATIC-Kommunikation über Ethernet

  9. #26
    Tigerente1974 ist offline Erfahrener Benutzer
    Themenstarter
    Registriert seit
    06.10.2009
    Ort
    NRW
    Beiträge
    1.572
    Danke
    63
    Erhielt 259 Danke für 219 Beiträge

    Standard

    Hallo Harald. Vielen Dank für Dein feedback.
    Es drückt grade etwas die Zeit für mein Projekt. Trotzdem werde ich versuchen die Vorschläge noch umzusetzen.
    Wenn ich getesteten Code habe, stelle ich noch eine Aktualisierung ein.
    Meine Motivation läuft nackig mit einem Cocktail über eine Wiese.

  10. #27
    Tigerente1974 ist offline Erfahrener Benutzer
    Themenstarter
    Registriert seit
    06.10.2009
    Ort
    NRW
    Beiträge
    1.572
    Danke
    63
    Erhielt 259 Danke für 219 Beiträge

    Standard

    Hallo Harald.
    Ich hatte heute morgen etwas Zeit mich intensiver einzulesen.
    Das "Problem" mit der Datenkonsistenz wäre mir -wenn überhaupt- erst viel zu spät aufgefallen.
    Ich habe jetzt eine fertige Lösung, die Deine Anregungen aufgreift.
    Nächste Woche kann ich den Code testen und werde berichten.
    Meine Motivation läuft nackig mit einem Cocktail über eine Wiese.

  11. #28
    Tigerente1974 ist offline Erfahrener Benutzer
    Themenstarter
    Registriert seit
    06.10.2009
    Ort
    NRW
    Beiträge
    1.572
    Danke
    63
    Erhielt 259 Danke für 219 Beiträge

    Standard

    Wie angekündigt poste ich die neue Version.
    Diese berücksichtigt die bisherigen Anregungen. Vor allem auch das Einlesen der Variablen über eine Rezeptur, um Datenkonsistenz zu gewährleisten.
    Bisher sind mir noch keine Fehler aufgefallen. Für weitere Anregungen bin ich weiterhin dankbar.

    1. Variablen per Rezeptur einlesen
    Code:
    ' Sub Variable_einlesen
    ' Um Datenkonsistenz für die zu archivierenden Variablen sicherzustellen, wurden diese in der
    ' Rezeptur "ReadVar" deklariert. Mit "GetDataRecordTagsFromPLC" werden die Variablen aus der SPS
    ' gelesen. Anschließend wird das Skript "String_archivieren_USB" angestossen, um die Daten zunächst 
    ' auf dem USB-Stick am HMI zu archivieren.
    
    Dim wrStat, rdStat
    
    ' Variable in SPS schreiben mit Fertigmeldung
     SetDataRecordTagsToPLC "WriteVar", SmartTags("Archivierung\Schreibstatus")
    ' in Schleife auf Ende Var-Schreiben warten
    Do
        wrStat = SmartTags("Archivierung\Schreibstatus")
    Loop While (wrStat And 4) = 0 ' 4=fertig OK / 12=abgebrochen mit Fehler
    
    ' wenn Schreiben ohne Fehler, dann Antwort (Protokoll-Datensatz) aus SPS lesen
    If wrStat = 4 Then
        ' Variablen aus SPS lesen mit Fertigmeldung
        GetDataRecordTagsFromPLC "ReadVar", SmartTags("Archivierung\Lesestatus")
        ' in Schleife auf Ende Var-Lesen warten
        Do
            rdStat = SmartTags("Archivierung\Lesestatus")
        Loop While (rdStat And 4) = 0 ' 4=fertig OK / 12=abgebrochen mit Fehler
    
        If rdStat = 4 Then
            String_archivieren_USB("\Storage Card USB\")
        End If
    End If
    
    If wrStat <> 4 Or rdStat <> 4 Then
        ShowSystemAlarm "Fehler beim Lesen der Protokollwerte!"
    End If
    2. Archivieren auf den USB-Stick
    Code:
    ' Sub String_archivieren_USB(StoragePath)
    
    Dim fs, f, FName, Header, strDir
    
    ' FileSystemObject erstellen
    ' Create FileSystemObject
    Set fs = CreateObject("FileCtl.FileSystem")
     
    ' Prüfen ob USB-Stick vorhanden ist
    strDir = fs.dir ("\Storage Card USB\")	
    
    If strDir = "" Then 'Ablagepfad nicht vorhanden
    	Call ShowSystemAlarm ("Kein USB-Stick vorhanden")
    Else
    	
    ' Archivierungspfad (Eingangsparameter) und Dateiname zusammensetzen 
    FName = StoragePath & "\PAL_ID" & ".csv"
    
    ' FileObject erstellen
     Set f = CreateObject("FileCtl.File")
    
    'Prüfen ob Ablagepfad vorhanden, wenn nicht -> erzeugen.
    Ordnerpfad_anlegen StoragePath ' Übergabe des Ablagepfades aus dem Script "Ordnerpfad anlegen"
    
    ' Datei öffnen bzw. erstellen, wenn sie noch nicht existiert
     f.open FName, 8 								
    
    ' Werte der Variablen mit Zeitstempel in die Archivdatei schreiben
     f.lineprint(CStr(Now) & ";" & CStr(SmartTags("Archivierung\ARCHIV_COMMDB.PAL_ID")) & ";" & CStr(SmartTags("Archivierung\ARCHIV_COMMDB.Pal_Hoehe"))) 
    
    ' Datei wieder schließen
     f.Close
    End If
    
    ' Verwendeten Speicher wieder freigeben
    Set f  = Nothing
    Set fs = Nothing
    
    ' Prüfen, ob Daten auf den Server geschrieben werden können
    Datei_kopieren	'Skript zum Kopieren der Daten vom Stick auf den Server anstoßen
    3. Prüfen, ob Daten auf den Server kopiert werden können.
    Wenn ja: Quelldatei Zeile für Zeile auslesen und in die Zieldatei schreiben.
    Anschließend die Quelldatei löschen.
    Code:
    'Sub Datei_kopieren
    
    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" 
        
    SmartTags("Archivierung\Status_kopieren") = 10                'Text: Suche USB-Stick
        
    If  PathSearch.Dir("\" & Path) = "" Then
    	SmartTags("Archivierung\Status_kopieren") = 20            'Text: USB-Stick nicht gefunden!
        ElseIf PathSearch.Dir("\" & Path) = Path Then     
        SmartTags("Archivierung\Status_kopieren") = 30            'Text: Suche Zielordner
    End If
    
    '30: Ziellaufwerk suchen
    '-----------------------
    
    If SmartTags("Archivierung\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
        		SmartTags("Archivierung\Status_kopieren") = 50      'Text: Schreibfreigabe prüfen
        		Exit Do
        	ElseIf Now >= StopTime Then    
            	SmartTags("Archivierung\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("Archivierung\Status_kopieren") = 50 Then
    	Path = "\\LAPTOP_WO\Logs\Write_Access.ok"                  
        Result = Ziel_pruefen (Path)
        If  Result = "Write_Access.ok" Then
        	SmartTags("Archivierung\Status_kopieren") = 70          'Text: Zieldatei suchen
        Else  
            SmartTags("Archivierung\Status_kopieren") = 60          'Text: keine Schreibfreigabe
    	End If
    End If 
    
    '70: Zieldatei prüfen
    '---------------------
    
    If SmartTags("Archivierung\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
     	
    	Result = Ziel_pruefen (Path)
        If  Result = "Archiv.csv" Then
        	SmartTags("Archivierung\Status_kopieren") = 90            'Text: Quelldatei einlesen
        Else    
            SmartTags("Archivierung\Status_kopieren") = 80            'Text: Zieldatei nicht gefunden
    	End If
    End If 
    
    '90: Datei suchen und auslesen
    '-----------------------------
    
    If SmartTags("Archivierung\Status_kopieren") = 90 Then
    	
    	Set fso = CreateObject("FileCtl.FileSystem")
    	
    	SmartTags("Archivierung\Name") = fso.Dir("\Storage Card USB\*.csv")        'Suchen nach erster csv-Datei auf Stick
    	f.open("\Storage Card USB\" & SmartTags("Archivierung\Name")),1,1
    	
    	' Inhalt der gefundenen Datei Zeile für Zeile einlesen
    	Do
    		If f.EOF = True Then Exit Do
    		fileContent = fileContent & f.LineInputString & vbCrLf
    	Loop
    	'Leerzeile am Ende abtrennen (sonst wird später mit jedem Kopiervorgang eine Leerzeile eingefügt)
    	Laenge = Len (fileContent)
    	fileContent = Left(fileContent,(Laenge-2))
    	' Datei wieder schließen
     	f.Close
     	SmartTags("Archivierung\Status_kopieren") = 100				'Text: Quelldaten übertragen
    End If 
    
    
    '100: Einträge im Appendmodus anhängen
    '-------------------------------------
    
    If SmartTags("Archivierung\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 
    
    	SmartTags("Archivierung\Status_kopieren") = 110			'Text: Quelldatei löschen
    End If
    	
    '110: Quelldatei löschen
    '-----------------------
    
    'Damit die übertragenen Daten nicht erneut kopiert werden, soll die Quelldatei gelöscht werden. 
    If SmartTags("Archivierung\Status_kopieren") = 110 Then
    	 fs.Kill ("\Storage Card USB\" & SmartTags("Archivierung\Name"))
    	 SmartTags("Archivierung\Status_kopieren") = 200
    End If
    
    ' Verwendeten Speicher wieder freigeben
    Set f  = Nothing
    Set fs = Nothing
    Set fso = Nothing
    Set PathSearch = Nothing
    Weiter werden noch diese Skripte verwendet:

    Sub-Routine Ordnerpfad anlegen:
    Code:
    'Sub Ordnerpfad_anlegen
    
    '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.
    
    Dim fs, strDir, strTemp, arr
    
    ' FileSystemObject erstellen
    Set fs = CreateObject("FileCtl.FileSystem") 
    
    strTemp = "" ' Hilfsvariable
    
    arr = Split (strPath, "\") ' Ablagepfad in einzelen "\" zerlegen
    
    For Each strDir In arr ' Schleifenzähler 
    	If Len(strDir) > 0 Then
    		strTemp = strTemp + "\" + strDir
    		
    		strDir = fs.dir (strTemp)
    		
    		If strDir = "" Then ' Wenn kein "\" mehr vorhanden ist -> keine weiteren Unterpfade
    			fs.mkDir strTemp
    		End If	
    	End If
    Next 
    
    ' Verwendeten Speicher wieder freigeben
    Set fs = Nothing
    Funktion Ziel prüfen:
    Code:
    'Function Ziel_pruefen(Ziel)
    
    ' Die Funktion gibt den Namen des letzten Ordners bzw. der Datei zurück,
    ' wenn dieser/diese im übergebenen Zielpfad vorhanden ist.
    Dim fso
      Set fso = CreateObject("FileCtl.FileSystem")
      Ziel_pruefen = fso.Dir(Ziel)
    Meine Motivation läuft nackig mit einem Cocktail über eine Wiese.

  12. #29
    Tigerente1974 ist offline Erfahrener Benutzer
    Themenstarter
    Registriert seit
    06.10.2009
    Ort
    NRW
    Beiträge
    1.572
    Danke
    63
    Erhielt 259 Danke für 219 Beiträge

    Standard

    Jetzt muss ich den thread doch nochmal ausgraben...

    Bei der Inbetriebnahme ist noch ein neues Problem ausgetaucht.
    Der Barcode zu der Palette ist ein String mit 20 Zeichen. Auf der SPS-Seite wurde der String wie gewünscht eingetragen.
    Bei der Archivierung des Strings scheint der String als Zahl interpretiert zu werden. Jedenfalls werden die beiden Führungsnullen des Barcodes weggestrichen. "Sehen" kann ich das beim Öfnnen der csv-Datei auf dem USB-Stick. Schlimmer ist aber, dass der Barcode quasi gerundet wird.
    Wie kann ich dafür sorgen, dass mein String 1:1 in die csv-Datei eingetragen wird?
    Meine Motivation läuft nackig mit einem Cocktail über eine Wiese.

  13. #30
    Registriert seit
    05.10.2005
    Beiträge
    2.373
    Danke
    321
    Erhielt 296 Danke für 266 Beiträge

    Standard


    Zuviel Werbung?
    -> Hier kostenlos registrieren
    Mit was öffnest du die .csv? Texteditor oder Excell? Bei letzterem hatte ich dies auch schon, obwohl es in der csv korrekt war.

    Wähle einen Beruf, den du liebst,und du brauchst keinen Tag in deinem Leben mehr zu arbeiten. Konfuzius

Ähnliche Themen

  1. Archivierung / Reorganisation
    Von Manfred Stangl im Forum Simatic
    Antworten: 1
    Letzter Beitrag: 17.08.2008, 22:49
  2. Azyklische Archivierung in WinCC V4.0
    Von Anfängerproggi im Forum HMI
    Antworten: 0
    Letzter Beitrag: 11.10.2007, 09:22
  3. Archivierung eines S7 Programms
    Von 1schilcher im Forum Simatic
    Antworten: 6
    Letzter Beitrag: 09.03.2007, 08:15
  4. Tag Logging + Archivierung
    Von mrdanger im Forum HMI
    Antworten: 1
    Letzter Beitrag: 29.01.2007, 10:47
  5. ProTool; Archivierung in Access
    Von DiplomandSPS im Forum HMI
    Antworten: 5
    Letzter Beitrag: 13.05.2004, 14:25

Lesezeichen

Berechtigungen

  • Neue Themen erstellen: Nein
  • Themen beantworten: Nein
  • Anhänge hochladen: Nein
  • Beiträge bearbeiten: Nein
  •