Solved

Serial port programming in VBA

Posted on 1998-08-05
1
773 Views
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.
0
Comment
Question by:kenll
1 Comment
 
LVL 9

Accepted Solution

by:
Dalin earned 100 total points
Comment Utility
kenll,
Try the following code. Let me know if you have questions
Regards
Dalin




       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()
       and
       '     ' 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
              Integer

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

       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)
                     Else
                            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
       buffer.
       '     '
       '     ' Return:Text string with received data. Can contain
       0-characters.
       '     '

       Function COM_ReadWait (ByVal iRequestedCnt As Integer, ByVal iTimeout As

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

                     Do

                                   DoEvents
                                          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

                                   Loop

                            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

                                                 Loop

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










0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

772 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now