Aus einer Datenbank werden jede Sekunde Zeiten nach Tabellenbaltt "RFID" Spalte C3:C1000 ausgelesen.
Es wird mit einem Excel Makro ausgelesen.
Hier ist das Makro:
Dim DateiPos As Long
Dim zeile As Integer
Dim datei As String
Option Explicit
Dim z As Double
Dim Startzeit As Date
Dim Uhrlaeuft As Boolean
Dim strMsg As String
Public NextTime As Date
Public Zeit1 As Date
Sub AusTextDatei()
DateiPos = 0
zeile = 0
datei = Application.GetOpenFilename("TagRegEx.dat,*.dat")
Cells(1, 1) = 1
LeseAbPos
End Sub
Sub LeseAbPos()
Dim Zeilenoffset As Integer
Dim strTxt As String
Dim FileLen As Long
If Cells(1, 1) 1 Then
Exit Sub
End If
Zeilenoffset = 2 'erste beiden Zeilen für die Überschriften
Open datei For Input As #1
Seek #1, DateiPos + 1
FileLen = LOF(1)
' Nur zur Information
'Cells(1, 2) = FileLen
'Cells(1, 3) = DateiPos
Do Until DateiPos >= FileLen
' in zeile wird die aktuelle Zeilennummer als
' globale Variable zwischen den Aufrufen gespeichert!
zeile = zeile + 1
' Zeile Einlesen
Line Input #1, strTxt
' Verarbeiten und das nächste mal nach den gelesenen Zeilen weiterlesen
' Hinter jeder Zeile folgen 2 Zeichen Zeilentrenner!
DateiPos = DateiPos + 2 + VerarbeiteZeile(strTxt, zeile + Zeilenoffset)
Loop
Cells(1, 4) = zeile
Close #1
'Uhrzeitspalte formatieren
Range(Cells(3, 3), Cells(ActiveSheet.Rows.Count, 3).End(xlUp)).NumberFormat _
= "hh:mm:ss.000"
'MsgBox "Habe die Daten ausgelesen!"
' wieder aufufen nach .. Sekunden
Application.OnTime Now + TimeValue("00:00:01"), "LeseAbPos"
End Sub
' Rückgabe: Länge der eingelesenen Zeile
Function VerarbeiteZeile(strZeile As String, intAktRow As Integer) As Integer
Dim iCol As Integer, iPosSemicolon As Integer
Dim ZeilenLänge As Integer
On Error GoTo Fehler
iCol = 1
' Erwartet wird ein Ausdruck, der von den Zeichenpositionen genau so aufgebaut ist:
' Länge einer Zeile muss 40 sein!!
ZeilenLänge = 40
VerarbeiteZeile = 0
Cells(intAktRow, iCol) = zeile
iCol = iCol + 1
If Len(strZeile) > ZeilenLänge Or Len(strZeile)
Cells(intAktRow, iCol) = "Fehler: " & strZeile
VerarbeiteZeile = Len(strZeile)
Exit Function
End If
iPosSemicolon = InStr(20, strZeile, ";")
'Datum auslesen
Cells(intAktRow, iCol) = CDate(Left(strZeile, 10))
'Uhrzeit auslesen, in Zahl umwandeln _
und 1000stel Sekunden ausschneiden, umwandeln und addieren
Cells(intAktRow, iCol + 1) = CDbl(CDate(Mid(strZeile, 12, 8))) _
+ CDbl(Mid(strZeile, 21, iPosSemicolon - 21)) / 1000 / 24 / 3600
'Text nach Semicolon enlesen
Cells(intAktRow, iCol + 2) = Mid(strZeile, iPosSemicolon + 1, 16)
Fehler:
If Err.Number 0 Then
Cells(intAktRow, iCol) = "Fehler: " & strZeile
End If
VerarbeiteZeile = Len(strZeile)
End Function
Public Sub StopEinlesen()
Cells(1, 1) = 0
End Sub
Wäre nach jedem neuen Eintrag in Zelle C3:C1000 ein Ton möglich?
Danke für eure Hilfe!
Gruß
Rolf