can anyone tell me why at startup and on a bad read this program cycles thru the comm event 2-3 times? I"ve tried turning it off with inBufferCount, but it didn't work. It's an app for a stationary raster scanner.
Option Explicit
Public prod As String
Public lot As String
Public scan As String
Public conn As ADODB.Connectio n
Public rs As ADODB.Recordset
Public cmd As ADODB.Command
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
Set conn = DataEnvironment 1.Connection1
Set rs = DataEnvironment 1.rsCommand1
On Error GoTo commerr
With MSComm1
MSComm1.CommPor t = 1
MSComm1.PortOpe n = True
MSComm1.Handsha king = comRTS
MSComm1.RThresh old = 13
MSComm1.RTSEnab le = True
MSComm1.Setting s = "9600,E,7,1 "
MSComm1.InputLe n = 0
End With
commerr:
If Err.Number = 8005 Then
MSComm1.PortOpe n = True
Resume Next
End If
End Sub
Private Sub MSComm1_OnComm( )
Dim noread As String
noread = "NOREAD"
scan = ""
txtscandata.Tex t = ""
txtscandata.Bac kColor = vbWhite
lot = ""
prod = ""
txtdesc.Visible = False
txtdesc.BackCol or = vbWhite
txtdesc.Text = ""
Select Case MSComm1.CommEve nt
Case comEvReceive
txtscandata.Tex t = MSComm1.Input
scan = Trim(txtscandat a.Text)
If Len(Trim(scan)) >= 13 And InStr(scan, noread) = 0 Then
Call HandleInput
Else
txtscandata.Tex t = "Bad scan- scan it again!"
txtscandata.Bac kColor = vbRed
Beep
Beep
Beep
'Sleep 4000
End If
Case Else
txtscandata.Tex t = "No Data"
txtscandata.Bac kColor = vbRed
Beep
Beep
'Beep
Sleep 2000
End Select
MSComm1.InBuffe rCount = 0
Sleep 3000
txtscandata.Tex t = "Ready to Scan"
txtscandata.Bac kColor = vbWhite
scan = ""
lot = ""
prod = ""
txtdesc.Visible = False
txtdesc.BackCol or = vbWhite
txtdesc.Text = ""
End Sub
Private Sub Form_Unload(Can cel As Integer)
MSComm1.PortOpe n = False
End Sub
Public Sub HandleInput()
Dim desc As String
scan = Trim(scan)
prod = Mid(scan, 1, 6)
lot = Mid(scan, 8, 13)
On Error GoTo Errorexit
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set cmd.ActiveConne ction = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "pValidateWSSca n"
cmd.Parameters. Append cmd.CreateParam eter("@prod", adChar, adParamInput, 10, Trim(prod))
cmd.Parameters. Append cmd.CreateParam eter("@lot", adChar, adParamInput, 20, Trim(lot))
cmd.Parameters. Append cmd.CreateParam eter("@desc", adChar, adParamOutput, 20, Trim(desc))
cmd.Execute
desc = cmd(2)
If Trim(desc) = "Invalid Product!" Or Trim(desc) = "" Then
txtdesc.BackCol or = vbRed
txtdesc.Visible = True
txtdesc.Text = "Invalid Product!"
Beep
Beep
Beep
Sleep 2000
Set cmd = Nothing
Else
txtdesc.Visible = True
txtscandata.Bac kColor = vbGreen
txtdesc.BackCol or = vbGreen
txtdesc.Text = desc
Set cmd = Nothing
Sleep 2000
End If
Errorexit:
If Err.Number = 94 Then
Resume Next
End If
End Sub
Option Explicit
Public prod As String
Public lot As String
Public scan As String
Public conn As ADODB.Connectio n
Public rs As ADODB.Recordset
Public cmd As ADODB.Command
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
Set conn = DataEnvironment 1.Connection1
Set rs = DataEnvironment 1.rsCommand1
On Error GoTo commerr
With MSComm1
MSComm1.CommPor t = 1
MSComm1.PortOpe n = True
MSComm1.Handsha king = comRTS
MSComm1.RThresh old = 13
MSComm1.RTSEnab le = True
MSComm1.Setting s = "9600,E,7,1 "
MSComm1.InputLe n = 0
End With
commerr:
If Err.Number = 8005 Then
MSComm1.PortOpe n = True
Resume Next
End If
End Sub
Private Sub MSComm1_OnComm( )
Dim noread As String
noread = "NOREAD"
scan = ""
txtscandata.Tex t = ""
txtscandata.Bac kColor = vbWhite
lot = ""
prod = ""
txtdesc.Visible = False
txtdesc.BackCol or = vbWhite
txtdesc.Text = ""
Select Case MSComm1.CommEve nt
Case comEvReceive
txtscandata.Tex t = MSComm1.Input
scan = Trim(txtscandat a.Text)
If Len(Trim(scan)) >= 13 And InStr(scan, noread) = 0 Then
Call HandleInput
Else
txtscandata.Tex t = "Bad scan- scan it again!"
txtscandata.Bac kColor = vbRed
Beep
Beep
Beep
'Sleep 4000
End If
Case Else
txtscandata.Tex t = "No Data"
txtscandata.Bac kColor = vbRed
Beep
Beep
'Beep
Sleep 2000
End Select
MSComm1.InBuffe rCount = 0
Sleep 3000
txtscandata.Tex t = "Ready to Scan"
txtscandata.Bac kColor = vbWhite
scan = ""
lot = ""
prod = ""
txtdesc.Visible = False
txtdesc.BackCol or = vbWhite
txtdesc.Text = ""
End Sub
Private Sub Form_Unload(Can cel As Integer)
MSComm1.PortOpe n = False
End Sub
Public Sub HandleInput()
Dim desc As String
scan = Trim(scan)
prod = Mid(scan, 1, 6)
lot = Mid(scan, 8, 13)
On Error GoTo Errorexit
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set cmd.ActiveConne ction = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "pValidateWSSca n"
cmd.Parameters. Append cmd.CreateParam eter("@prod", adChar, adParamInput, 10, Trim(prod))
cmd.Parameters. Append cmd.CreateParam eter("@lot", adChar, adParamInput, 20, Trim(lot))
cmd.Parameters. Append cmd.CreateParam eter("@desc", adChar, adParamOutput, 20, Trim(desc))
cmd.Execute
desc = cmd(2)
If Trim(desc) = "Invalid Product!" Or Trim(desc) = "" Then
txtdesc.BackCol or = vbRed
txtdesc.Visible = True
txtdesc.Text = "Invalid Product!"
Beep
Beep
Beep
Sleep 2000
Set cmd = Nothing
Else
txtdesc.Visible = True
txtscandata.Bac kColor = vbGreen
txtdesc.BackCol or = vbGreen
txtdesc.Text = desc
Set cmd = Nothing
Sleep 2000
End If
Errorexit:
If Err.Number = 94 Then
Resume Next
End If
End Sub