1

The below code hangs until serial data is received. I've tracked it down to the "Get #COMfile, , record" part, which I assume has an infinite timeout. Is there a better way to do this so i can work with excel while simultaneously getting serial data?

Note: This code is ubiquitous, and MS documentation scarce. Most posts on this topic are very old (<= 2010). I did find some documentation on the "Get, Open, etc" functions here but not enough to figure out why it waits for data to come in on the serial port before returning.

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
braX
  • 11,506
  • 5
  • 20
  • 33
user3496060
  • 800
  • 10
  • 20

0 Answers0