Barcode Scanner in excel - excel

Question

Right now I have a spreadsheet in excel with some vba in it to use as an inventory database for our small business. The problem is that we are growing and I need to get more sophisticated.
The scanner is used with a Userform with a textbox control monitoring the number of characters that come into the textbox. When the specified number of characters is triggered the system does its job. What I need to accomplish is a way to monitor the input coming from the scanner itself without using a textbox control so that I can set up multiple scanners without them interfering with one another.
Any direction on this is greatly appreciated.
Here is the code:
Private Sub TextBox1_Change()
On Error GoTo endgame
Dim barCode As String
Dim charNumb As Long
barCode = TextBox1.Text
charNumb = Len(barCode)
'This triggers the system to perform actions based on the barcode number
'received. All of my barcodes for this version are formatted to have only 5
'characters. Works great with a single user and scanner.
If charNumb = 5 Then
Cells.Find(barCode).Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell = ActiveCell + 1
ActiveCell.Offset(0, 17).Activate
ActiveCell = ActiveCell + 1
If ActiveCell = ActiveCell.Offset(0, -1) Then
ActiveCell.Offset(0, -1).Clear
ActiveCell.Clear
GoTo TIMESTAMPER
Else
GoTo TIMESTAMPER
End If
TIMESTAMPER:
TextBox1.Text = ""
'Timestamp
ActiveCell.Offset(0, -5).Activate
With ActiveCell
.Formula = Now
.NumberFormat = "m/d/yyyy h:mm:ss AM/PM"
End With
ActiveWorkbook.Save
ActiveCell.EntireRow.Select
TextBox1.SetFocus
End If
GoTo AllEndsWell
endgame:
Call errorsound
AllEndsWell:
End Sub

Answer 1

I have previously attempted to add barcode reader support to Excel and while the following has not been fully tested, I recall it was working; however there are some requirements to make it work
Within the code to follow, a barcode read is performed when a system message has been 'peaked' at and starts with a specific character. Most barcode readers can be programmed to output text in a certain way; the code requires an invisible precursor to be added to strings which is detected via msgMessage.wParam (Code example Case 17) and an enter character to follow the string to show when the barcode read is complete and reset the listener
For your barcode readers you may need to alter which character is prefixed and it's associated detection character (Ascii value. i.e. 17)
My current code:
The following code should be placed in a Class Module 'KeyPressApi'
Option Explicit
Private Type BARCODEBUFFER
strBuf As String
bCode As Boolean
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Declare Function TranslateMessage Lib "user32" _
(ByRef lpMsg As MSG) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE As Long = &H1
Private Const WM_CHAR As Long = &H102
Private bExitLoop As Boolean
Private bufBuffer As BARCODEBUFFER
Public Event BarcodeRead(Barcode As String, ByRef Cancel As Boolean)
Public Sub StartKeyPressInit()
Dim msgMessage As MSG
Dim bCancel As Boolean
Dim iMessage As Integer
Dim iKeyCode As Integer
Dim lXLhwnd As Long
On Error GoTo errHandler
Application.EnableCancelKey = xlErrorHandler
bExitLoop = False 'Initialize boolean flag.
lXLhwnd = FindWindow("XLMAIN", Application.Caption) 'Get the app hwnd.
Do
WaitMessage 'check for a key press and remove it from the msg queue.
If PeekMessage(msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
iKeyCode = msgMessage.wParam 'store the virtual key code for later use.
iMessage = msgMessage.Message
TranslateMessage msgMessage 'translate the virtual key code into a char msg.
PeekMessage msgMessage, lXLhwnd, WM_CHAR, WM_CHAR, PM_REMOVE
bCancel = False
Select Case iKeyCode 'Enter and backspace not handled correctly by below case statement
Case 8 ' Backspace
If bufBuffer.bCode = True Then
If Len(bufBuffer.strBuf) > 0 Then
bufBuffer.strBuf = Left(bufBuffer.strBuf, Len(bufBuffer.strBuf) - 1)
bCancel = True
End If
End If
Case 13 ' End of barcode string so reset to off mode
If bufBuffer.bCode = True Then
bufBuffer.bCode = False
RaiseEvent BarcodeRead(ReadBuffer(), 0)
bCancel = True
End If
Case Else
End Select
Select Case msgMessage.wParam
Case 17 ' Start of Barcode; Initialize buffer array
If bufBuffer.bCode = False Then
bufBuffer.bCode = True
bufBuffer.strBuf = ""
bCancel = True
End If
Case Else ' All other data
If bufBuffer.bCode = True Then
If iKeyCode <> 0 Then
bufBuffer.strBuf = bufBuffer.strBuf & Chr(msgMessage.wParam)
bCancel = True
End If
End If
End Select
'if the key pressed is allowed post it to the application.
If Not bCancel Then PostMessage lXLhwnd, iMessage, iKeyCode, 0
End If
errHandler: 'Allow the processing of other msgs.
DoEvents
Loop Until bExitLoop
End Sub
Public Sub StopKeyPressWatch()
bExitLoop = True 'Set this boolean flag to exit the above loop.
End Sub
Public Function ReadBuffer() As String
ReadBuffer = bufBuffer.strBuf
Dim i As Integer
For i = 1 To 31
ReadBuffer = Replace(ReadBuffer, Chr(i), "")
Next
End Function
Then within the sheet that you want to override the listener
Option Explicit
Dim WithEvents CKeyWatcher As KeyPressApi
Private Sub Worksheet_Activate()
If CKeyWatcher Is Nothing Then Set CKeyWatcher = New KeyPressApi
If Not CKeyWatcher Is Nothing Then CKeyWatcher.StartKeyPressInit
End Sub
Private Sub Worksheet_Deactivate()
If Not CKeyWatcher Is Nothing Then CKeyWatcher.StopKeyPressWatch
End Sub
Private Sub CKeyWatcher_BarcodeRead(strBuffer As String, Cancel As Boolean)
MsgBox strBuffer
End Sub