Serial port programming in VBA

Posted on 1998-08-05
Last Modified: 2008-02-26
I am attempting to communicate with a serial device over the com1 port in Excel using VBA.  How can I
access the port, send and receive ASCII codes using VBA.
Question by:kenll
1 Comment

Accepted Solution

Dalin earned 100 total points
ID: 1467970
Try the following code. Let me know if you have questions

       Global i_ComErr As Integer
       Global i_hComm As Integer ' COMM - handle
       Dim l_TicksPerSecAs Long
       ' The following type needed only for passing to the coml_Bui
       '     ldCommDCB()
       '     ' coml_SetCommState() functions

       Type coml_TDCB ' device control block
              Id As String * 1
              BaudRate As Integer
              ByreSize As String * 1
              Parity As String * 1
              StopBits As String * 1
              RlsTimeOut As Integer
              CtsTimeout As Integer
              Flags As Integer
              XonChar As String * 1
              XoffChar As String * 1
              XonLim As Integer
              XoffLim As Integer
              PeChar As String * 1
              EofChar As String * 1
              EvtChar As String * 1
              TxDelay As Integer
       End Type

       Type coml_TCOMSTAT
              status As String * 1'specifies status of the transmission
              cbInQue As Integer 'number of characters in the receive queue
              cbOutQue As Integer 'number of characyers in the transmit queue
       End Type

       Type coml_TDIALINFO
              szPhone As String'phone number
              szPrefix As String 'prefix
              fUsePrefix As Integer'True / False flag
              eBaudRate As Integer'Baud rate : control panel settings
              eDialType As Integer'Pulse or Tone : control panel settings
              eCom As Integer 'port settings (control panel)
              szDevice As String 'what is passed to the OpenComm (COM1, COM2,
              idCommDev As Integer'communication device identifier
       End Type

       Declare Function coml_ReadComm Lib "User" Alias "ReadComm" (ByVal nCid
              As Integer, ByVal lpBuf As String, ByVal nRequested As Integer) As

       Declare Function coml_OpenComm Lib "User" Alias "#200" (ByVal lpComName
              As String, ByVal wInQueue As Integer, ByVal wOutQueue As Integer) As

       Declare Function coml_WriteComm Lib "User" Alias "#205" (ByVal nCid As
              Integer, ByVal lpBuf As String, ByVal nSize As Integer) As Integer

       Declare Function coml_CloseComm Lib "User" Alias "#207" (ByVal nCid As
              Integer) As Integer

       Declare Function coml_FlushComm Lib "User" Alias "#215" (ByVal nCid As
              Integer, ByVal nQueue As Integer) As Integer

       Declare Function coml_GetCommState Lib "User" Alias "#202" (ByVal
              idComDev As Integer, lpDCB As coml_TDCB) As Integer

       Declare Function coml_SetCommState Lib "User" Alias "#201" (lpDCB As
              coml_TDCB) As Integer

       Declare Function coml_GetCommError Lib "User" Alias "#203" (ByVal
              idComDev As Integer, lpStat As coml_TCOMSTAT) As Integer

       Declare Function coml_BuildCommDCB Lib "User" Alias "#213" (ByVal
              szPortInfo As String, lpDCB As coml_TDCB) As Integer

       Declare Function coml_fGetTickCount Lib "User" Alias "#13" () As Long

       ' Close the serial channel. Do not forget to close it, becau
       '     se all
       attempts to open it again
       '     ' will fail if it isn't closed.
       '     '

       Sub COM_Close ()

              Dim res As Integer
              res = coml_CloseComm(i_hComm)
       End Sub

       '     ' Returns the status code of the previous function or sub.
       '     '
       '     ' 0 = OK
       '     '

       Function COM_Error () As Integer

              COM_Error = i_ComErr
       End Function

       '     '
       '     ' Flush the queue buffers of windows
       '     '
       '     ' iWas: 0=transmission queue, 1=receive queue
       '     '

       Sub COM_Flush (ByVal iWas%)

              Dim res%
              res = coml_FlushComm(i_hComm, iWas)
       End Sub

       '     ' Open a serial port.
       '     '
       ' szPortInfo specifies the port, baud rate and other setting
       '     s.
       '     'Example: COM1:9600,n,8,1
       '     ' The format of the string is as for the DOS MODE command.
       '     '
       ' In case of errors a messagebox will be displayed and COM_E
       '     rror
       '     ' returns a value <> 0.
       '     '
       ' Do not forget to call COM_Close at the end of the program
       '     !
       '     '

       Sub COM_Open (ByVal szPortInf As String)

              Static DCB As coml_TDCB
              Dim ComStatInfo As coml_TCOMSTAT
              Dim pos As Integer
              Dim res As Integer
              Dim szComm As String
              Static szPortInfo As String * 30
              ' Size in bytes of the input and output queue. Adapt if nece
              '     ssary.
              Const CB_INQUEUE = 256
              Const CB_OUTQUEUE = 256
              szPortInfo = szPortInf
              pos = InStr(szPortInfo, ":")

                     If pos < 1 Then
                            MsgBox "COMx: not specified.", 48, "COM_Open Error (" & 
                            szPortInfo & ")"
                            i_ComErr = 1001
                            Exit Sub
                     End If

              szComm = Left$(szPortInfo, pos - 1)
              i_hComm = coml_OpenComm(szComm, CB_INQUEUE, CB_OUTQUEUE)

                     If i_hComm < 0 Then
                            MsgBox "COM-Port cannot be opened.", 48, "COM_Open Error (" & 
                            szPortInfo & ")"
                            i_ComErr = 1002
                            Exit Sub
                     End If

              res = 0

                     If Not coml_BuildCommDCB(szPortInfo, DCB) Then
                            res = coml_SetCommState(DCB)
                            res = coml_GetCommError(i_hComm, ComStatInfo)
                     End If

                     If res < 0 Then
                            MsgBox "Cannot set baud rate of COM port.", 48, "COM_Open Error
                            (" & szPortInfo & ")"
                            i_ComErr = 1003
                            Exit Sub
                     End If

              i_ComErr = 0
       End Sub

       ' Read serial port, wait until requested amount of bytes is
       '     available in
       the input buffer.
       '     '
       ' iRequestedCnt Number of bytes to read. If less bytes are r
       '     eceived
       within the timeout,
       '     'COM_ReadWait returns an empty string and COM_Error
       returns 3001.
       '     '
       '     ' iTimeout Timeout in seconds. The function waits for the
       specified time
       '     'if less than iRequestedCnt bytes are in the input
       '     '
       '     ' Return:Text string with received data. Can contain
       '     '

       Function COM_ReadWait (ByVal iRequestedCnt As Integer, ByVal iTimeout As

              Dim res As Integer
              Dim ComStatInfo As coml_TCOMSTAT
              Dim t
              Dim szBufAs String
              szBuf = String$(iRequestedCnt + 1, 0)
              t = Timer


                                          res = coml_GetCommError(i_hComm, ComStatInfo)

                                                 If iTimeout > 0 Then

                                                               If Timer > t + iTimeout Then
                                                                      szBuf = "" 
                                                                      i_ComErr = 3001
                                                                      COM_ReadWait = "" 
                                                                      Exit Function
                                                               End If

                                                 End If

                                   Loop Until ComStatInfo.cbInQue >= iRequestedCnt

                            res = coml_ReadComm(i_hComm, szBuf, iRequestedCnt)

                                   If res <> iRequestedCnt Then
                                          MsgBox "Error receiving data.", 48, "COM_ReadWait Error " 
                                          i_ComErr = 3002
                                          COM_ReadWait = "" 
                                   End If

                            i_ComErr = 0
                            COM_ReadWait = szBuf
                     End Function

              '     ' Write data to serial port.
              '     '
              '     ' szBuf String buffer containing data
              '     '

       Sub COM_Write (ByVal szBuf As String)

              Dim res As Integer
              Dim ComStatInfo As coml_TCOMSTAT
              Dim szBufferAs String
              Dim StartTimeAs Long
              Dim t
              Dim iBuflen As Integer
              iBuflen = Len(szBuf)
              t = Timer

                     Do While True

                                   If coml_WriteComm(i_hComm, szBuf, iBuflen) > 0 Then Exit Do
                                          res = coml_GetCommError(i_hComm, ComStatInfo)
                                          res = coml_FlushComm(i_hComm, 0)

                                                 If Timer > t + 10 Then
                                                        MsgBox "Timeout on WriteComm (Write).", 48, "COM_Write Error
                                                        (" & szBuf & ")"
                                                        i_ComErr = 2001
                                                        Exit Sub
                                                 End If


                            StartTime = coml_fGetTickCount()

                                   Do While True
                                          res = coml_GetCommError(i_hComm, ComStatInfo)

                                                 If ComStatInfo.cbOutQue = 0 Then Exit Do

                                                               If (coml_fGetTickCount() - StartTime) > 30000 Then
                                                                      MsgBox "Timeout on WriteComm (Status).", 48, "COM_Write
                                                                      Error (" & szBuf & ")"
                                                                      i_ComErr = 2002
                                                                      Exit Sub
                                                               End If


                                          res = coml_FlushComm(i_hComm, 0)
                                          i_ComErr = 0
                                   End Sub


Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article ( for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question