Advertisement
Advertisement
| 09.18.2008 at 04:57PM PDT, ID: 23744453 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: |
Option Explicit
Private Sub closePortBTN_Click()
mscomm1.PortOpen = False
End Sub
Private Sub openPortBTN_Click()
'Declarations
'Dim selPort As Integer
'initializations
'selPort = portCMBX.Text
'Setup comm port
'If mscomm1.PortOpen Then mscomm1.PortOpen = False
mscomm1.CommPort = 3 'Port that is being used for the connection
mscomm1.Settings = "9600, n, 8, 1"
mscomm1.InputLen = 0
mscomm1.PortOpen = True
If Not mscomm1.PortOpen Then GoTo pError
pError:
Select Case Err.Number
Case 8005:
listBX.AddItem ("COM" & portCMBX.Value & " Unavailable")
listBX1.Text = "COM " & portCMBX.Value & " Unavailable" & vbCrLf
Err.Clear
Resume Next
Case 0:
MSComm1_OnComm
'On Error Resume Next
Case Else:
listBX.AddItem ("Error " & Err.Number & " : " & Err.Description)
listBX1.Text = "Error " & Err.Number & " : " & Err.Description & vbCrLf
Err.Clear
Resume Next
End Select
Exit Sub
End Sub
Private Sub UserForm_Initialize()
loadPorts
End Sub
Public Sub loadPorts()
'Variable declarations
Dim port As Integer
'Loop through system to find available com ports
For port = 1 To 16
mscomm1.CommPort = port
mscomm1.Settings = "9600,N,8,1"
mscomm1.InputLen = 0
On Error Resume Next 'GoTo portError 'Send to portError event it occurs
mscomm1.PortOpen = True
Select Case Err.Number
Case 8005:
listBX.AddItem ("COM" & port & " Unavailable")
listBX1.Text = "COM" & port & " Unavailable" & " "
Err.Clear
'Resume Next
Case 8002:
listBX.AddItem ("COM" & port & " Does not exist")
listBX1.Text = "COM" & port & " Does not exist" & " "
Err.Clear
'Resume Next
Case 0:
If mscomm1.PortOpen = True Then mscomm1.PortOpen = False
portCMBX.AddItem ("COM " & port)
'Resume Next
Case 20:
Err.Clear
Case Else:
listBX.AddItem ("Error " & Err.Number & " : " & Err.Description)
listBX1.Text = "Error " & Err.Number & " : " & Err.Description & " "
Err.Clear
'Resume Next
End Select
Next port
End Sub
Private Sub MSComm1_OnComm()
'Declarations
Dim dataBuff, p, Message As String
'MSComm events
Select Case mscomm1.CommEvent
' Errors
Case comEventBreak ' A Break was received.
Case comEventCDTO ' CD (RLSD) Timeout.
Case comEventCTSTO ' CTS Timeout.
Case comEventDSRTO ' DSR Timeout.
Case comEventFrame ' Framing Error.
Case comEventOverrun ' Data Lost.
Case comEventRxOver ' Receive buffer overflow.
Case comEventRxParity ' Parity Error.
Case comEventTxFull ' Transmit buffer full.
Case comEventDCB ' Unexpected error retrieving DCB]
Case comEvReceive
'Loop to gather gps data
dataBuff = mscomm1.Input 'dataBuff & mscomm1.Input 'append Input data to our buffer
p = InStr(dataBuff, vbCrLf)
If p > 0 Then
Message = Left$(dataBuff, p - 1) 'extract first full line
ParseMessage (Message)
dataBuff = Mid$(dataBuff, p + 2) 'remove the used data
End If
'ActiveSheet.Cells = p
End Select
End Sub
Sub ParseMessage(strMessage As String)
Dim strData() As String
Dim r As Integer
Dim c As Integer
strData = Split(strMessage, ",")
r = 1
Do Until ActiveSheet.Cells(r, 1) = ""
r = r + 1
Loop
For c = 1 To UBound(strData) + 1
ActiveSheet.Cells(r, c) = strData(c - 1)
Next c
End Sub
|