以下代码将挂起,直到接收到串行数据为止。我已经将其跟踪到“获取#COMfile,记录”部分,我认为它具有无限的超时时间。有没有更好的方法可以做到这一点,这样我就可以在同时获取串行数据的同时使用excel?
注意:此代码无处不在,并且缺少MS文档。关于该主题的大多数帖子都非常老(<= 2010)。我确实找到了有关“获取,打开等”功能here的一些文档,但不足以弄清楚为什么它在返回之前等待数据进入串行端口。
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64-Bit versions of Excel
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
Dim cntr As Integer
cntr = 0
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 + TimeValue("00:00:20") 'if no data received in 20 sec give up
timeout = Now + (timespan / 86400) 'if no data received in 20 sec give up
'MsgBox ("Now:" & Now & " Timeout:" & timeout)
Do While stopclick = False
DoEvents
Get #COMfile, , record
' 'MsgBox ("record:" & Asc(record))
' DoEvents 'Don't lock up excel while waiting
' 'MsgBox ("ASCII:" & Asc(record))
' If record <> "," And Asc(record) <> 13 And Asc(record) <> 10 And record <> emptyRecord Then
' record_cat = record_cat & record
' End If
' 'MsgBox (record_cat)
' If Asc(record) = 13 Then
' 'MsgBox ("Congratulations! You found an enter successfully Dave.")
' Range("A1").Offset(ROWindex, COLindex).Value = Trim(record_cat)
' COLindex = 0
' record_cat = ""
' record = ""
' 'ActiveCell.Offset(1, 0).Select
' ROWindex = ROWindex + 1
' timeout = Now + TimeValue("00:00:20") 'if no data received in 20 sec give up
' ElseIf record = "," Then
' 'MsgBox ("Here is a comma.")
' Range("A1").Offset(ROWindex, COLindex).Value = Trim(record_cat)
' record_cat = ""
' COLindex = COLindex + 1
' timeout = Now + TimeValue("00:00:20") 'if no data received in 20 sec give up
' End If
Sleep 20
cntr = cntr + 1
Range("A1").Value = cntr
If Now >= timeout Then
MsgBox ("Timed out. Program ending.")
Close #COMfile
Exit Do
End If
Loop
Close #COMfile
Debug.Print "Finished"
End Sub