Unable to run the coding completely

[kimhoong79]

Below is a visual Basic coding to retrieve data from a COM port and process the data and store the data to a mssql server using ODBC connection.

Problem that I faced is the it seems like will not run completely. It will not process my data and will not store it. It will only write it to the textbox and also text file. But while i debug it with F8 key , everything go smooth.

Is there anyway to make sure that it will run completely?


Option Explicit
Dim strDate As String
Dim strTime As String
Dim strExt As String
Dim strCO As String
Dim strDialNo As String
Dim strDuration As String
Dim strNewInput As String
Dim strring As String
Dim strtempc As String
Dim sMessage As String
Dim strnewrecord As String, strCompany As String
Dim strcounster As Integer
Dim strMS1 As String, strMS2 As String
Dim strMS3 As String, strMS4 As String
Dim strlen As Integer, strcounter As Integer
Dim i As Integer, a As Integer, b As Integer
Dim strlen2 As Integer, strlefttel As String
Dim strtel As String, strstatus As String
Dim strCat As String

Private Sub cboComm_Change()
On Error Resume Next
MSComm1.CommPort = cboComm.Text
If Err Then
SetStatus "Err " & Err & ". " & Error, True
Else
SetStatus "Changed to Com Port " & cboComm.Text, True
End If
End Sub

Private Sub cboComm_Click()
Call cboComm_Change
End Sub

Private Sub cmdClear_Click()
txtOutput.Text = ""
End Sub

Private Sub ListComPorts()
Dim i As Integer

cboComm.Clear
SetStatus "Getting Available Com Ports... ", True
For i = 1 To 16
If COMAvailable(i) Then
cboComm.AddItem i
SetStatus "Com " & i & " found ", False
End If
Next
cboComm.ListIndex = 0
End Sub

Private Sub cmdGetComPorts_Click()
ListComPorts
End Sub

Private Sub cmdCOMStatus_Click()
On Error GoTo ErrHandler
If cmdCOMStatus.Caption = "Close COM Port" Then
SetStatus "Closing COM Port " & MSComm1.CommPort, True
MSComm1.PortOpen = False
cmdCOMStatus.Caption = "Open COM Port"
Else
SetStatus "Opening COM Port " & MSComm1.CommPort, True
MSComm1.PortOpen = True
cmdCOMStatus.Caption = "Close COM Port"
End If
Exit Sub
ErrHandler:
SetStatus "Err " & Err & ". " & Error, True
End Sub

Private Sub Form_Load()

SetRS
SetCN
Dim i As Integer

MSComm1.Settings = "9600,n,8,1"
Show
'DoEvents
ListComPorts
SetStatus "Opening COM Port " & MSComm1.CommPort, True
MSComm1.PortOpen = True
cmdCOMStatus.Caption = "Close COM Port"
End Sub

Private Sub MSComm1_OnComm()

Dim FS As New FileSystemObject
Dim TS As TextStream
Dim FLName As String

FLName = "C:\COMM PORT"
FLName = FLName & "\" & "Calls" & Format(Now, "YYYYMM") & ".txt"
If MSComm1.CommEvent = 2 Then
If FS.FileExists(FLName) Then
sMessage = StrConv(MSComm1.Input, vbUnicode)
Set TS = FS.OpenTextFile(FLName, ForAppending)
Else
Set TS = FS.CreateTextFile(FLName, True)
End If

strlen = Len(sMessage)

SetStatus (sMessage), False
strtempc = Left(sMessage, 1)

DoEvents
GetRecord

TS.Write sMessage
TS.Close

End If
End Sub

Private Sub GetRecord()

If Asc(strtempc) >= "48" And Asc(strtempc) <= "57" Then

i = 1
a = 1
strcounter = strlen / 82
While i <= strcounter

strnewrecord = Mid(sMessage, a, 82)
DoEvents
ProcessRecord
i = i + 1
a = a + 82
Wend

Else

If strlen > 50 Then

'strMS1 = Mid(sMessage, 1, 185)
strlen2 = strlen - 166
sMessage = Mid(sMessage, 166, strlen2)
strcounter = strlen2 / 82
i = 1
a = 1

While i <= strcounter

strnewrecord = Mid(sMessage, a, 82)
DoEvents
ProcessRecord
i = i + 1
a = a + 82
Wend

End If

End If
End Sub

Private Sub ProcessRecord()

strDate = Mid(strnewrecord, 1, 8)
strTime = Mid(strnewrecord, 10, 7)
strExt = Mid(strnewrecord, 20, 3)
strCO = Mid(strnewrecord, 24, 2)
strDialNo = Mid(strnewrecord, 27, 17)
strDuration = Mid(strnewrecord, 58, 8)

strlefttel = Left(strDialNo, 1)
If strlefttel = "<" Then
strtel = Trim(Mid(strDialNo, 4, 14))
strstatus = "In"
Else
strtel = Trim(strDialNo)
strstatus = "Out"
End If

sql = " Select * from [TelList] where [tel1] = '" & strtel & "' or [tel2] = '" & strtel & "' or [fax] = '" & strtel & "'"
Set rs = cn.Execute(sql)

If Not rs.EOF Then

strCompany = rs!Name
strCat = rs!Category
Else

strCompany = "Unknown"
strCat = "Unknown"

End If

sql = "Insert into records ( [C_date] , [C_time] , [Ext] , [Co] , [DialNo] , [Duration], [Status] , [Name], [Category] ) values " & _
"('" & strDate & "', '" & ReplaceComments(strTime) & "', '" & strExt & "', '" & strCO & "', '" & ReplaceComments(strDialNo) & "'," & _
"'" & ReplaceComments(strDuration) & "', '" & strstatus & "', '" & ReplaceComments(strCompany) & "', '" & strCat & "') "
' cn.BeginTrans
' DoEvents
cn.Execute (sql)
' DoEvents
'cn.CommitTrans


End Sub

Private Sub SetStatus(sStatus As String, bOperation As Boolean)
txtOutput = txtOutput & IIf(bOperation, "-> ", "") & sStatus
txtOutput.SelStart = Len(txtOutput)
'ProcessRecord
txtOutput.Refresh
End Sub

Private Sub ReceiveResponse(sResponse As String)
txtOutput = txtOutput & "Response Received" & vbCrLf & sResponse & vbCrLf & "End of Reponse"
txtOutput.SelStart = Len(txtOutput)
txtOutput.Refresh
End Sub

Private Sub cmdGetAllPorts_Click()
Dim NumPorts As Long
Dim i As Integer

NumPorts = GetAvailablePorts("")
SetStatus "Getting All Available Ports... ", True

For i = 0 To NumPorts - 1
SetStatus Ports(i).pPortName, False
Next
End Sub

 

[Homersim2600]

You need to put something like this under Mscomm_OnComm Event...

Private Sub MSComm1_OnComm()
Dim sData As String

If MSComm1.CommEvent = comEvReceive Then
sData = MSComm1.Input
Else
End If

End Sub

Also, On Form_load make sure this is there...
MSComm1.RThreshold = 1

This should work fine for you...

LF