USB Communication with MS Excel - Page 1
Forum section: electronics / projects

author: TopherTheME
author_rank: Regular Contributor
timestamp: November 28, 2010, 09:21:47 pm
content: In a previous thread I was complaining about how MS dropped the MSComm API for office 07 and 10. After a lot of searching I finally found a way to communicate through the USB port using Excel and thought I would share. Below is the code I used and I also attached the Excel file and the source code I used to communicate with a PIC32 using a FTDI interface chip. The Excel file just opens, writes, and reads data over a COM port. The PIC32 just echo's data that was received using the UART interrupt and toggles an LED to show UART activity.The VBA code came from here:http://dev.emcelettronica.com/serial-port-communication-excel-vbaI just modified the code slightly for my own purposes.Due to the character restrictions, I will post everything in a few posts.

author: TopherTheME
author_rank: Regular Contributor
timestamp: November 28, 2010, 09:24:08 pm
content: Main Code:Code:Option Explicit'-------------------------------------------------------------------------------'' This VB module is a collection of routines to perform serial port I/O without' using the Microsoft Comm Control component. This module uses the Windows API' to perform the overlapped I/O operations necessary for serial communications.'' The routine can handle up to 4 serial ports which are identified with a' Port ID.'' All routines (with the exception of CommRead and CommWrite) return an error' code or 0 if no error occurs. The routine CommGetError can be used to get' the complete error message.'-------------------------------------------------------------------------------'-------------------------------------------------------------------------------' Public Constants'-------------------------------------------------------------------------------' Output Control Lines (CommSetLine)Const LINE_BREAK = 1Const LINE_DTR = 2Const LINE_RTS = 3' Input Control Lines (CommGetLine)Const LINE_CTS = &H10&Const LINE_DSR = &H20&Const LINE_RING = &H40&Const LINE_RLSD = &H80&Const LINE_CD = &H80&'-------------------------------------------------------------------------------' System Constants'-------------------------------------------------------------------------------Private Const ERROR_IO_INCOMPLETE = 996&Private Const ERROR_IO_PENDING = 997Private Const GENERIC_READ = &H80000000Private Const GENERIC_WRITE = &H40000000Private Const FILE_ATTRIBUTE_NORMAL = &H80Private Const FILE_FLAG_OVERLAPPED = &H40000000Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000Private Const OPEN_EXISTING = 3' COMM FunctionsPrivate Const MS_CTS_ON = &H10&Private Const MS_DSR_ON = &H20&Private Const MS_RING_ON = &H40&Private Const MS_RLSD_ON = &H80&Private Const PURGE_RXABORT = &H2Private Const PURGE_RXCLEAR = &H8Private Const PURGE_TXABORT = &H1Private Const PURGE_TXCLEAR = &H4' COMM Escape FunctionsPrivate Const CLRBREAK = 9Private Const CLRDTR = 6Private Const CLRRTS = 4Private Const SETBREAK = 8Private Const SETDTR = 5Private Const SETRTS = 3'-------------------------------------------------------------------------------' System Structures'-------------------------------------------------------------------------------Private Type COMSTATfBitFields As Long ' See Comment in Win32API.TxtcbInQue As LongcbOutQue As LongEnd TypePrivate Type COMMTIMEOUTSReadIntervalTimeout As LongReadTotalTimeoutMultiplier As LongReadTotalTimeoutConstant As LongWriteTotalTimeoutMultiplier As LongWriteTotalTimeoutConstant As LongEnd Type'' The DCB structure defines the control setting for a serial' communications device.'Private Type DCBDCBlength As LongBaudRate As LongfBitFields As Long ' See Comments in Win32API.TxtwReserved As IntegerXonLim As IntegerXoffLim As IntegerByteSize As ByteParity As ByteStopBits As ByteXonChar As ByteXoffChar As ByteErrorChar As ByteEofChar As ByteEvtChar As BytewReserved1 As Integer 'Reserved; Do Not UseEnd TypePrivate Type OVERLAPPEDInternal As LongInternalHigh As Longoffset As LongOffsetHigh As LonghEvent As LongEnd TypePrivate Type SECURITY_ATTRIBUTESnLength As LonglpSecurityDescriptor As LongbInheritHandle As LongEnd Type'-------------------------------------------------------------------------------' System Functions'-------------------------------------------------------------------------------'' Fills a specified DCB structure with values specified in' a device-control string.'Private Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" _(ByVal lpDef As String, lpDCB As DCB) As Long'' Retrieves information about a communications error and reports' the current status of a communications device. The function is' called when a communications error occurs, and it clears the' device's error flag to enable additional input and output' (I/O) operations.'

author: TopherTheME
author_rank: Regular Contributor
timestamp: November 28, 2010, 09:24:56 pm
content: Main Code Continued:Code:Private Declare Function ClearCommError Lib "kernel32" _(ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long'' Closes an open communications device or file handle.'Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long'' Creates or opens a communications resource and returns a handle' that can be used to access the resource.'Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _ByVal dwShareMode As Long, lpSecurityAttributes As Any, _ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _ByVal hTemplateFile As Long) As Long'' Directs a specified communications device to perform a function.'Private Declare Function EscapeCommFunction Lib "kernel32" _(ByVal nCid As Long, ByVal nFunc As Long) As Long'' Formats a message string such as an error string returned' by anoher function.'Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _Arguments As Long) As Long'' Retrieves modem control-register values.'Private Declare Function GetCommModemStatus Lib "kernel32" _(ByVal hFile As Long, lpModemStat As Long) As Long'' Retrieves the current control settings for a specified' communications device.'Private Declare Function GetCommState Lib "kernel32" _(ByVal nCid As Long, lpDCB As DCB) As Long'' Retrieves the calling thread's last-error code value.'Private Declare Function GetLastError Lib "kernel32" () As Long'' Retrieves the results of an overlapped operation on the' specified file, named pipe, or communications device.'Private Declare Function GetOverlappedResult Lib "kernel32" _(ByVal hFile As Long, lpOverlapped As OVERLAPPED, _lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long'' Discards all characters from the output or input buffer of a' specified communications resource. It can also terminate' pending read or write operations on the resource.'Private Declare Function PurgeComm Lib "kernel32" _(ByVal hFile As Long, ByVal dwFlags As Long) As Long'' Reads data from a file, starting at the position indicated by the' file pointer. After the read operation has been completed, the' file pointer is adjusted by the number of bytes actually read,' unless the file handle is created with the overlapped attribute.' If the file handle is created for overlapped input and output' (I/O), the application must adjust the position of the file pointer' after the read operation.'Private Declare Function ReadFile Lib "kernel32" _(ByVal hFile As Long, ByVal lpBuffer As String, _ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, _lpOverlapped As OVERLAPPED) As Long'' Configures a communications device according to the specifications' in a device-control block (a DCB structure). The function' reinitializes all hardware and control settings, but it does not' empty output or input queues.'Private Declare Function SetCommState Lib "kernel32" _(ByVal hCommDev As Long, lpDCB As DCB) As Long'' Sets the time-out parameters for all read and write operations on a' specified communications device.'Private Declare Function SetCommTimeouts Lib "kernel32" _(ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long'' Initializes the communications parameters for a specified' communications device.'Private Declare Function SetupComm Lib "kernel32" _(ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long'' Writes data to a file and is designed for both synchronous and a' synchronous operation. The function starts writing data to the file' at the position indicated by the file pointer. After the write' operation has been completed, the file pointer is adjusted by the' number of bytes actually written, except when the file is opened with' FILE_FLAG_OVERLAPPED. If the file handle was created for overlapped' input and output (I/O), the application must adjust the position of' the file pointer after the write operation is finished.'Private Declare Function WriteFile Lib "kernel32" _(ByVal hFile As Long, ByVal lpBuffer As String, _ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, _lpOverlapped As OVERLAPPED) As LongPrivate Declare Sub AppSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)'-------------------------------------------------------------------------------' Program Constants'-------------------------------------------------------------------------------Private Const MAX_PORTS = 4'-------------------------------------------------------------------------------' Program Structures'-------------------------------------------------------------------------------Private Type COMM_ERRORlngErrorCode As LongstrFunction As StringstrErrorMessage As StringEnd TypePrivate Type COMM_PORTlngHandle As LongblnPortOpen As BooleanudtDCB As DCBEnd Type'-------------------------------------------------------------------------------' Program Storage'-------------------------------------------------------------------------------Private udtCommOverlap As OVERLAPPEDPrivate udtCommError As COMM_ERRORPrivate udtPorts(1 To MAX_PORTS) As COMM_PORT'-------------------------------------------------------------------------------' GetSystemMessage - Gets system error text for the specified error code.'-------------------------------------------------------------------------------Public Function GetSystemMessage(lngErrorCode As Long) As StringDim intPos As IntegerDim strMessage As String, strMsgBuff As String * 256Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, lngErrorCode, 0, strMsgBuff, 255, 0)intPos = InStr(1, strMsgBuff, vbNullChar)If intPos > 0 ThenstrMessage = Trim$(Left$(strMsgBuff, intPos - 1))ElsestrMessage = Trim$(strMsgBuff)End IfGetSystemMessage = strMessageEnd FunctionPublic Function PauseApp(PauseInSeconds As Long)Call AppSleep(PauseInSeconds * 1000)End Function

author: TopherTheME
author_rank: Regular Contributor
timestamp: November 28, 2010, 09:26:09 pm
content: ...more main code:Code:'-------------------------------------------------------------------------------' CommOpen - Opens/Initializes serial port.''' Parameters:' intPortID - Port ID used when port was opened.' strPort - COM port name. (COM1, COM2, COM3, COM4)' strSettings - Communication settings.' Example: "baud=9600 parity=N data=8 stop=1"'' Returns:' Error Code - 0 = No Error.''-------------------------------------------------------------------------------Public Function CommOpen(intPortID As Integer, strPort As String, _strSettings As String) As LongDim lngStatus As LongDim udtCommTimeOuts As COMMTIMEOUTSOn Error GoTo Routine_Error' See if port already in use.If udtPorts(intPortID).blnPortOpen ThenlngStatus = -1With udtCommError.lngErrorCode = lngStatus.strFunction = "CommOpen".strErrorMessage = "Port in use."End WithGoTo Routine_ExitEnd If' Open serial port.udtPorts(intPortID).lngHandle = CreateFile(strPort, GENERIC_READ Or _GENERIC_WRITE, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)If udtPorts(intPortID).lngHandle = -1 ThenlngStatus = SetCommError("CommOpen (CreateFile)")GoTo Routine_ExitEnd IfudtPorts(intPortID).blnPortOpen = True' Setup device buffers (1K each).lngStatus = SetupComm(udtPorts(intPortID).lngHandle, 1024, 1024)If lngStatus = 0 ThenlngStatus = SetCommError("CommOpen (SetupComm)")GoTo Routine_ExitEnd If' Purge buffers.lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR)If lngStatus = 0 ThenlngStatus = SetCommError("CommOpen (PurgeComm)")GoTo Routine_ExitEnd If' Set serial port timeouts.With udtCommTimeOuts.ReadIntervalTimeout = -1.ReadTotalTimeoutMultiplier = 0.ReadTotalTimeoutConstant = 1000.WriteTotalTimeoutMultiplier = 0.WriteTotalTimeoutMultiplier = 1000End WithlngStatus = SetCommTimeouts(udtPorts(intPortID).lngHandle, udtCommTimeOuts)If lngStatus = 0 ThenlngStatus = SetCommError("CommOpen (SetCommTimeouts)")GoTo Routine_ExitEnd If' Get the current state (DCB).lngStatus = GetCommState(udtPorts(intPortID).lngHandle, _udtPorts(intPortID).udtDCB)If lngStatus = 0 ThenlngStatus = SetCommError("CommOpen (GetCommState)")GoTo Routine_ExitEnd If' Modify the DCB to reflect the desired settings.lngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB)If lngStatus = 0 ThenlngStatus = SetCommError("CommOpen (BuildCommDCB)")GoTo Routine_ExitEnd If' Set the new state.lngStatus = SetCommState(udtPorts(intPortID).lngHandle, _udtPorts(intPortID).udtDCB)If lngStatus = 0 ThenlngStatus = SetCommError("CommOpen (SetCommState)")GoTo Routine_ExitEnd IflngStatus = 0Routine_Exit:CommOpen = lngStatusExit FunctionRoutine_Error:lngStatus = Err.NumberWith udtCommError.lngErrorCode = lngStatus.strFunction = "CommOpen".strErrorMessage = Err.DescriptionEnd WithResume Routine_ExitEnd FunctionPrivate Function SetCommError(strFunction As String) As LongWith udtCommError.lngErrorCode = Err.LastDllError.strFunction = strFunction.strErrorMessage = GetSystemMessage(.lngErrorCode)SetCommError = .lngErrorCodeEnd WithEnd FunctionPrivate Function SetCommErrorEx(strFunction As String, lngHnd As Long) As LongDim lngErrorFlags As LongDim udtCommStat As COMSTATWith udtCommError.lngErrorCode = GetLastError.strFunction = strFunction.strErrorMessage = GetSystemMessage(.lngErrorCode)Call ClearCommError(lngHnd, lngErrorFlags, udtCommStat).strErrorMessage = .strErrorMessage & " COMM Error Flags = " & _Hex$(lngErrorFlags)SetCommErrorEx = .lngErrorCodeEnd WithEnd Function'-------------------------------------------------------------------------------' CommSet - Modifies the serial port settings.'' Parameters:' intPortID - Port ID used when port was opened.' strSettings - Communication settings.' Example: "baud=9600 parity=N data=8 stop=1"'' Returns:' Error Code - 0 = No Error.'-------------------------------------------------------------------------------Public Function CommSet(intPortID As Integer, strSettings As String) As LongDim lngStatus As LongOn Error GoTo Routine_ErrorlngStatus = GetCommState(udtPorts(intPortID).lngHandle, _udtPorts(intPortID).udtDCB)If lngStatus = 0 ThenlngStatus = SetCommError("CommSet (GetCommState)")GoTo Routine_ExitEnd IflngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB)If lngStatus = 0 ThenlngStatus = SetCommError("CommSet (BuildCommDCB)")GoTo Routine_ExitEnd IflngStatus = SetCommState(udtPorts(intPortID).lngHandle, _udtPorts(intPortID).udtDCB)If lngStatus = 0 ThenlngStatus = SetCommError("CommSet (SetCommState)")GoTo Routine_ExitEnd IflngStatus = 0Routine_Exit:CommSet = lngStatusExit FunctionRoutine_Error:lngStatus = Err.NumberWith udtCommError.lngErrorCode = lngStatus.strFunction = "CommSet".strErrorMessage = Err.DescriptionEnd WithResume Routine_ExitEnd Function

author: TopherTheME
author_rank: Regular Contributor
timestamp: November 28, 2010, 09:27:00 pm
content: more....Code:'-------------------------------------------------------------------------------' CommClose - Close the serial port.'' Parameters:' intPortID - Port ID used when port was opened.'' Returns:' Error Code - 0 = No Error.'-------------------------------------------------------------------------------Public Function CommClose(intPortID As Integer) As LongDim lngStatus As LongOn Error GoTo Routine_ErrorIf udtPorts(intPortID).blnPortOpen ThenlngStatus = CloseHandle(udtPorts(intPortID).lngHandle)If lngStatus = 0 ThenlngStatus = SetCommError("CommClose (CloseHandle)")GoTo Routine_ExitEnd IfudtPorts(intPortID).blnPortOpen = FalseEnd IflngStatus = 0Routine_Exit:CommClose = lngStatusExit FunctionRoutine_Error:lngStatus = Err.NumberWith udtCommError.lngErrorCode = lngStatus.strFunction = "CommClose".strErrorMessage = Err.DescriptionEnd WithResume Routine_ExitEnd Function'-------------------------------------------------------------------------------' CommFlush - Flush the send and receive serial port buffers.'' Parameters:' intPortID - Port ID used when port was opened.'' Returns:' Error Code - 0 = No Error.'-------------------------------------------------------------------------------Public Function CommFlush(intPortID As Integer) As LongDim lngStatus As LongOn Error GoTo Routine_ErrorlngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR)If lngStatus = 0 ThenlngStatus = SetCommError("CommFlush (PurgeComm)")GoTo Routine_ExitEnd IflngStatus = 0Routine_Exit:CommFlush = lngStatusExit FunctionRoutine_Error:lngStatus = Err.NumberWith udtCommError.lngErrorCode = lngStatus.strFunction = "CommFlush".strErrorMessage = Err.DescriptionEnd WithResume Routine_ExitEnd Function'-------------------------------------------------------------------------------' CommRead - Read serial port input buffer.'' Parameters:' intPortID - Port ID used when port was opened.' strData - Data buffer.' lngSize - Maximum number of bytes to be read.'' Returns:' Error Code - 0 = No Error.'-------------------------------------------------------------------------------Public Function CommRead(intPortID As Integer, strData As String, _lngSize As Long) As LongDim lngStatus As LongDim lngRdSize As Long, lngBytesRead As LongDim lngRdStatus As Long, strRdBuffer As String * 1024Dim lngErrorFlags As Long, udtCommStat As COMSTATOn Error GoTo Routine_ErrorstrData = ""lngBytesRead = 0DoEvents' Clear any previous errors and get current status.lngStatus = ClearCommError(udtPorts(intPortID).lngHandle, lngErrorFlags, _udtCommStat)If lngStatus = 0 ThenlngBytesRead = -1lngStatus = SetCommError("CommRead (ClearCommError)")GoTo Routine_ExitEnd IfIf udtCommStat.cbInQue > 0 ThenIf udtCommStat.cbInQue > lngSize ThenlngRdSize = udtCommStat.cbInQueElselngRdSize = lngSizeEnd IfElselngRdSize = 0End IfIf lngRdSize ThenlngRdStatus = ReadFile(udtPorts(intPortID).lngHandle, strRdBuffer, _lngRdSize, lngBytesRead, udtCommOverlap)If lngRdStatus = 0 ThenlngStatus = GetLastErrorIf lngStatus = ERROR_IO_PENDING Then' Wait for read to complete.' This function will timeout according to the' COMMTIMEOUTS.ReadTotalTimeoutConstant variable.' Every time it times out, check for port errors.' Loop until operation is complete.While GetOverlappedResult(udtPorts(intPortID).lngHandle, _udtCommOverlap, lngBytesRead, True) = 0lngStatus = GetLastErrorIf lngStatus <> ERROR_IO_INCOMPLETE ThenlngBytesRead = -1lngStatus = SetCommErrorEx( _"CommRead (GetOverlappedResult)", _udtPorts(intPortID).lngHandle)GoTo Routine_ExitEnd IfWendElse' Some other error occurred.lngBytesRead = -1lngStatus = SetCommErrorEx("CommRead (ReadFile)", _udtPorts(intPortID).lngHandle)GoTo Routine_ExitEnd IfEnd IfstrData = Left$(strRdBuffer, lngBytesRead)End IfRoutine_Exit:CommRead = lngBytesReadExit FunctionRoutine_Error:lngBytesRead = -1lngStatus = Err.NumberWith udtCommError.lngErrorCode = lngStatus.strFunction = "CommRead".strErrorMessage = Err.DescriptionEnd WithResume Routine_ExitEnd Function'-------------------------------------------------------------------------------' CommWrite - Output data to the serial port.'' Parameters:' intPortID - Port ID used when port was opened.' strData - Data to be transmitted.'' Returns:' Error Code - 0 = No Error.'-------------------------------------------------------------------------------Public Function CommWrite(intPortID As Integer, strData As String) As LongDim i As IntegerDim lngStatus As Long, lngSize As LongDim lngWrSize As Long, lngWrStatus As LongOn Error GoTo Routine_Error' Get the length of the data.lngSize = Len(strData)' Output the data.lngWrStatus = WriteFile(udtPorts(intPortID).lngHandle, strData, lngSize, _lngWrSize, udtCommOverlap)' Note that normally the following code will not execute because the driver' caches write operations. Small I/O requests (up to several thousand bytes)' will normally be accepted immediately and WriteFile will return true even' though an overlapped operation was specified.DoEventsIf lngWrStatus = 0 ThenlngStatus = GetLastErrorIf lngStatus = 0 ThenGoTo Routine_ExitElseIf lngStatus = ERROR_IO_PENDING Then' We should wait for the completion of the write operation so we know' if it worked or not.'' This is only one way to do this. It might be beneficial to place the' writing operation in a separate thread so that blocking on completion' will not negatively affect the responsiveness of the UI.'' If the write takes long enough to complete, this function will timeout' according to the CommTimeOuts.WriteTotalTimeoutConstant variable.' At that time we can check for errors and then wait some more.' Loop until operation is complete.While GetOverlappedResult(udtPorts(intPortID).lngHandle, _udtCommOverlap, lngWrSize, True) = 0lngStatus = GetLastErrorIf lngStatus <> ERROR_IO_INCOMPLETE ThenlngStatus = SetCommErrorEx( _"CommWrite (GetOverlappedResult)", _udtPorts(intPortID).lngHandle)GoTo Routine_ExitEnd IfWendElse' Some other error occurred.lngWrSize = -1lngStatus = SetCommErrorEx("CommWrite (WriteFile)", _udtPorts(intPortID).lngHandle)GoTo Routine_ExitEnd IfEnd IfFor i = 1 To 10DoEventsNextRoutine_Exit:CommWrite = lngWrSizeExit FunctionRoutine_Error:lngStatus = Err.NumberWith udtCommError.lngErrorCode = lngStatus.strFunction = "CommWrite".strErrorMessage = Err.DescriptionEnd WithResume Routine_ExitEnd Function

author: TopherTheME
author_rank: Regular Contributor
timestamp: November 28, 2010, 09:27:46 pm
content: last bit of the main code:Code:'-------------------------------------------------------------------------------' CommGetLine - Get the state of selected serial port control lines.'' Parameters:' intPortID - Port ID used when port was opened.' intLine - Serial port line. CTS, DSR, RING, RLSD (CD)' blnState - Returns state of line (Cleared or Set).'' Returns:' Error Code - 0 = No Error.'-------------------------------------------------------------------------------Public Function CommGetLine(intPortID As Integer, intLine As Integer, _blnState As Boolean) As LongDim lngStatus As LongDim lngComStatus As Long, lngModemStatus As LongOn Error GoTo Routine_ErrorlngStatus = GetCommModemStatus(udtPorts(intPortID).lngHandle, lngModemStatus)If lngStatus = 0 ThenlngStatus = SetCommError("CommReadCD (GetCommModemStatus)")GoTo Routine_ExitEnd IfIf (lngModemStatus And intLine) ThenblnState = TrueElseblnState = FalseEnd IflngStatus = 0Routine_Exit:CommGetLine = lngStatusExit FunctionRoutine_Error:lngStatus = Err.NumberWith udtCommError.lngErrorCode = lngStatus.strFunction = "CommReadCD".strErrorMessage = Err.DescriptionEnd WithResume Routine_ExitEnd Function'-------------------------------------------------------------------------------' CommSetLine - Set the state of selected serial port control lines.'' Parameters:' intPortID - Port ID used when port was opened.' intLine - Serial port line. BREAK, DTR, RTS' Note: BREAK actually sets or clears a "break" condition on' the transmit data line.' blnState - Sets the state of line (Cleared or Set).'' Returns:' Error Code - 0 = No Error.'-------------------------------------------------------------------------------Public Function CommSetLine(intPortID As Integer, intLine As Integer, _blnState As Boolean) As LongDim lngStatus As LongDim lngNewState As LongOn Error GoTo Routine_ErrorIf intLine = LINE_BREAK ThenIf blnState ThenlngNewState = SETBREAKElselngNewState = CLRBREAKEnd IfElseIf intLine = LINE_DTR ThenIf blnState ThenlngNewState = SETDTRElselngNewState = CLRDTREnd IfElseIf intLine = LINE_RTS ThenIf blnState ThenlngNewState = SETRTSElselngNewState = CLRRTSEnd IfEnd IflngStatus = EscapeCommFunction(udtPorts(intPortID).lngHandle, lngNewState)If lngStatus = 0 ThenlngStatus = SetCommError("CommSetLine (EscapeCommFunction)")GoTo Routine_ExitEnd IflngStatus = 0Routine_Exit:CommSetLine = lngStatusExit FunctionRoutine_Error:lngStatus = Err.NumberWith udtCommError.lngErrorCode = lngStatus.strFunction = "CommSetLine".strErrorMessage = Err.DescriptionEnd WithResume Routine_ExitEnd Function'-------------------------------------------------------------------------------' CommGetError - Get the last serial port error message.'' Parameters:' strMessage - Error message from last serial port error.'' Returns:' Error Code - Last serial port error code.'-------------------------------------------------------------------------------Public Function CommGetError(strMessage As String) As LongWith udtCommErrorCommGetError = .lngErrorCodestrMessage = "Error (" & CStr(.lngErrorCode) & "): " & .strFunction & _" - " & .strErrorMessageEnd WithEnd Function

author: TopherTheME
author_rank: Regular Contributor
timestamp: November 28, 2010, 09:29:05 pm
content: Code for the buttons:Code:Sub Button1_Click()Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4Dim lngStatus As LongintPortID = 4' Open COM portlngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _"baud=9600 parity=N data=8 stop=1")End SubCode:Sub Button2_Click()Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4Dim lngStatus As LongDim strData As StringintPortID = 4strData = CStr(Cells(2, 7)) 'load data from cell G2'Writa datalngStatus = CommWrite(intPortID, strData)End SubQuoteCode:Sub Button4_Click()Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4intPortID = 4Call CommClose(intPortID)End Sub