This is an app for a stationary raster scanner. No human input is needed, except to get the packages in front of the scanner. A good scan works great, including data update. However, on a bad scan the program cycles thru the comevent 2-3 times before stopping and waiting on input. It also does that when first firing up the prog. I"m changing screen color and text depending on validation, so I"m trying to have the correct response. Any help would be appreciated.
vb
Option Explicit
Public prod As String
Public lot As String
Public scan As String
Public conn As ADODB.Connection
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 = DataEnvironment1.Connection1
Set rs = DataEnvironment1.rsCommand1
On Error GoTo commerr
With MSComm1
MSComm1.CommPort = 1
MSComm1.PortOpen = True
MSComm1.Handshaking = comRTS
MSComm1.RThreshold = 13
MSComm1.RTSEnable = True
MSComm1.Settings = "9600,E,7,1"
MSComm1.InputLen = 0
End With
commerr:
If Err.Number = 8005 Then
MSComm1.PortOpen = True
Resume Next
End If
End Sub
Private Sub MSComm1_OnComm()
Dim noread As String
noread = "NOREAD"
scan = ""
txtscandata.Text = ""
txtscandata.BackColor = vbWhite
lot = ""
prod = ""
txtdesc.Visible = False
txtdesc.BackColor = vbWhite
txtdesc.Text = ""
Select Case MSComm1.CommEvent
Case comEvReceive
txtscandata.Text = MSComm1.Input
scan = Trim(txtscandata.Text)
If Len(Trim(scan)) >= 13 And InStr(scan, noread) = 0 Then
Call HandleInput
Else
txtscandata.Text = "Bad scan- scan it again!"
txtscandata.BackColor = vbRed
Beep
Beep
Beep
Sleep 4000
GoTo badscan
End If
Case Else
txtscandata.Text = "Ready to Scan"
MSComm1.InBufferCount = 0
Exit Sub
'txtscandata.BackColor = vbRed
'Beep
'Beep
'Beep
' Sleep 4000
End Select
badscan:
MSComm1.InBufferCount = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
MSComm1.PortOpen = 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.ActiveConnection = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "pValidateWSScan"
cmd.Parameters.Append cmd.CreateParameter("@prod", adChar, adParamInput, 10, Trim(prod))
cmd.Parameters.Append cmd.CreateParameter("@lot", adChar, adParamInput, 20, Trim(lot))
cmd.Parameters.Append cmd.CreateParameter("@desc", adChar, adParamOutput, 20, Trim(desc))
cmd.Execute
desc = cmd(2)
If Trim(desc) = "Invalid Product!" Or Trim(desc) = "" Then
txtdesc.BackColor = vbRed
txtdesc.Visible = True
txtdesc.Text = "Invalid Product!"
Beep
Beep
Beep
' Sleep 4000
Set cmd = Nothing
Exit Sub
Else
txtdesc.Visible = True
txtscandata.BackColor = vbGreen
txtdesc.BackColor = vbGreen
txtdesc.Text = desc
Set cmd = Nothing
' Sleep 4000
End If
Errorexit:
If Err.Number = 94 Then
Resume Next
End If
End Sub
'Private Sub OnComm_Idle()
'MSComm1.InBufferCount = 0
'txtscandata.Text = "Ready to Scan"
'scan = ""
'txtscandata.BackColor = vbWhite
'lot = ""
'prod = ""
'txtdesc.Visible = False
'txtdesc.BackColor = vbWhite
'txtdesc.Text = ""
'End Sub
| 