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