Hallo,
ich erfasse Daten in einer Access-Datenbank. Über die Port.dll wird die serielle Schnittstelle abgehört und die Werte in Variablen gespeichert. Diese werden dann über SQL-Befehle in die Datenbank eingetragen. Vor jedem Einlesen wird ein Abgleich mittels eines externen Atomuhrprogramms durchgeführt. Desweiteren stehen Berichte in Access zur Verfügung zwecks der Auswertung.
Das Problem:
Nach dem Starten der Datenbank wird eine Zeichenfolge eingelesen. Sporadisch steigt die Datenbank dann aus und liest nichts mehr an der seriellen Schnittstelle ein. Z.B. Wenn man auf den Bericht geklickt hat, oder es zum Abgleich mit der Atomuhr gekommen ist. Dies ist allerdings nicht immer der Fall. An der Schnittstelle kommen definitiv Daten an, habe es mittels einen Terminalprogramms überprüft.
Wer weiß Rat bzw. hat einen ähnlichen Fehler schon mal gehabt?
Ich wäre für jeden Tipp sehr dankbar!
Quellcode:
'Sub für Start der Messung
Sub Start_Messung()
Dim I As Byte
Dim Laenge, Start
'setzt Variable auf 1
E_Mail_Senden_Zeichen = 1
'setzt Variable auf 0
StopZeichen = 0
'Schließen der seriellen Schnittstelle
CLOSECOM
'Öffnen der seriellen Schnittstelle mit folgenden Parametern
OPENCOM ("COM1:2400,n,8,1")
'Aufruf der Sub bis Stop Zeichen gesetzt wird
Do While StopZeichen = 0
Messwert_auslesen
'Steuerung an andere Prozesse abgeben. Andere Anwendungen kann man ausführen
DoEvents
Debug.Print Time;
Loop
'Schließen der seriellen Schnittstelle
CLOSECOM
'Message-Box
MsgBox ("Ende")
End Sub
'################################################################
'Sub zum Messwert lesen an RS232
Sub Messwert_auslesen()
Dim rd As String
Dim I As Byte
Dim Datei1
Dim Ort As Integer
On Error Resume Next
Datei1 = Dir("WD.Flr")
'Wenn Datei nicht leer ist, dann
If Datei1 <> "" Then
'Öffnet Datei
Open "WD.Flr" For Input As #1
For I = 1 To 7
'Liest Datei aus
Line Input #1, S(I)
Next
'Schließt Datei
Close #1
Ort = Val(S(7)) '############### Ümit
'Schleife zum Durchlauf der Werte I von 1 bis 5
For I = 1 To 5
'schreibe zuerst in Werte "nichts" rein für Sicherheit, dass Wert leer ist
Wert(I) = ""
Next
'Schleife bis rd=13 (CR) oder rd=-1 (Fehler) gelesen wird
Do
I = 1
'dass man auch mittendrin einsteigen kann in der Zeichenfolge, die der µC sendet
rd = READBYTE
Do While rd > -1
'fügt Strings zusammen, keine mathematische Addition, da als String deklariert, solange rd ungleich 9 (TAB)
If rd <> 9 Then Wert(I) = Wert(I) + Chr(rd)
'Wenn rd=9 (TAB), dann inkrementiere I
If rd = 9 Then I = I + 1
'richter Messwert wird eingelesen
rd = READBYTE
'bei Zeichen CR oder Fehler Ausstieg aus der Schleife
If rd = 13 Or rd = -1 Then Exit Do
Loop
Loop Until rd = 13 Or rd = -1
'Wenn Fehlercode -1 gelesen wird, dann verlasse die Sub
If rd = -1 Then Exit Sub
Wert(1) = Right(Wert(1), 4) ' List den Wert von Rechts 4 Zeichen ein Ümit
Wert(2) = Right(Wert(2), 4)
Wert(3) = Right(Wert(3), 3)
Wert(4) = Right(Wert(4), 4)
Wert(5) = Right(Wert(5), 4)
'Berechnung des relativen Drucks in abhängig der Meereshöhe
Wert(1) = Round(Wert(1) + 1013.25 * (1 - ((288 - 0.0065 * Ort) / 288) ^ 5.255))
Debug.Print
'Ausschalten der Fehlermeldung
DoCmd.SetWarnings False
'Schreiben der eingelesenen Werte in die Felder der Tabelle
'Datum, Zeit usw. muss Bezeichnung in der Datenbank entsprechen
DoCmd.RunSQL ("insert into Messwerte (Datum, Zeit, Wert1, Wert2, Wert3, Wert4, Wert5) values ('" & Date & "','" & Time & "','" & Wert(1) & "','" & Wert(2) & "','" & Wert(3) & "','" & Wert(4) & "','" & Wert(5) & "')")
'Einschalten der Fehlermeldung
DoCmd.SetWarnings True
'hier werden die aktuellen Werte auf die jeweiligen Textfelder verteilt
'Form_Formular1.Text58.Enabled = True
Form_Formular1.Text58.Locked = False
Form_Formular1.Text58.SetFocus
Form_Formular1.Text58.Value = Wert(1)
Form_Formular1.Text58.Locked = True
'Form_Formular1.Text60.Enabled = True
Form_Formular1.Text60.Locked = False
Form_Formular1.Text60.SetFocus
Form_Formular1.Text60.Value = Wert(2)
Form_Formular1.Text60.Locked = True
'Form_Formular1.Text62.Enabled = True
Form_Formular1.Text62.Locked = False
Form_Formular1.Text62.SetFocus
Form_Formular1.Text62.Value = Wert(3)
Form_Formular1.Text62.Locked = True
If Form_Wetterstation.e_mail.Visible = True Then
'####################
If E_Mail_Senden_Zeichen = 1 Then
'Kontrolle ob Datei vorhanden
Datei1 = Dir("WD.Flr")
'Wenn Datei nicht leer ist, dann
If Datei1 <> "" Then
'Öffnet Datei
Open "WD.Flr" For Input As #1
For I = 1 To 6
'Liest Datei aus
Line Input #1, S(I)
Next
'Schließt Datei
Close #1
'Wenn Werte, die am Schieberegler eingestellt sind verletzt werden, rufe Sub auf
If S(5) <> "" Or S(6) <> "" Then
If Val(Wert(2)) > S(5) Or Val(Wert(2)) 0 Then
'Fenster im Vordergrung
Call SetWindowPos(wHandle, -1, 0, 0, 0, 0, 3)
'Abgleichen
SendKeys "%ZA", True
'Fenster Zurücksetzen
Call SetWindowPos(wHandle, -2, 0, 0, 0, 0, 3)
SendKeys "%{F4}", True
Else
'Programm wird ausgeführt
'Call Shell("C:\Programme\TWAtomTime\TWAtomTime.exe", 1)
Call Shell("C:\WINDOWS\system32\calc.exe", 1)
'Fenster im Vordergrung
Call SetWindowPos(wHandle, -1, 0, 0, 0, 0, 3)
'Abgleichen
SendKeys "%ZA", True
'Fenster Zurücksetzen
Call SetWindowPos(wHandle, -2, 0, 0, 0, 0, 3)
End If
'###############################'##################
End If
End If
Debug.Print Wert(1), Wert(2), Wert(3), Wert(4), Wert(5)
End Sub |