在Excel VBA中使用“获取#COMfile,记录”读取串行端口似乎有无限超时?

时间:2018-10-09 21:12:49

标签: excel vba excel-vba serial-port

以下代码将挂起,直到接收到串行数据为止。我已经将其跟踪到“获取#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

0 个答案:

没有答案