1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
| Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim record As String * 1, emptyRecord As String * 1
Dim stopclick As Boolean
Sub stoploop()
stopclick = True
MsgBox ("Finished.")
End Sub
Sub ReadCommPC()
Dim COMport As String
Dim COMfile As Integer
Dim COMstring As Variant
Dim baudrate As Long
Dim timeout As Date
Dim record_cat As Variant
Dim COLindex As Integer
Dim ROWindex As Integer
stopclick = False
COLindex = 0
ROWindex = 0
COMport = Sheets("Setup").Range("C2").Value
baudrate = Sheets("Setup").Range("C3").Value
timespan = Sheets("Setup").Range("C4") * 3
Sheets("Data").Select
Range("A1").Select
'Open COM# port with baud rate 9600, No parity, 8 data bits and 1 stop bit
COMfile = FreeFile
COMstring = COMport & ":" & baudrate & ",N,8,1"
Open COMstring For Random As #COMfile Len = 1
record = ""
record_cat = ""
timeout = Now + (timespan / 86400) 'if no data received in 20 sec give up
Do While stopclick = False
Get #COMfile, , record
DoEvents 'Don't lock up excel while waiting
If record <> "," And Asc(record) <> 13 And Asc(record) <> 10 And record <> emptyRecord Then
record_cat = record_cat & record
End If
If Asc(record) = 13 Then
Range("A1").Offset(ROWindex, COLindex).Value = Trim(record_cat)
COLindex = 0
record_cat = ""
record = ""
ROWindex = ROWindex + 1
timeout = Now + TimeValue("00:00:20") 'if no data received in 20 sec give up
End If
Loop
Close #COMfile
Debug.Print "Finished"
End Sub |
Partager