On our Box Inventory form there is an Add Barcode button which brings up an input box for the barcode. Here is the code behind that button:
Private Sub cmdBarcode_Click()
Dim strBar As String 'Variable for the barcode
Dim strCheck As String 'Variable to hold the output of CheckDigit()
'Pick up barcode from input box.
strBar = InputBox("Enter Barcode", "Barcode")
If strBar = "" Then
Exit Sub
Else:
strCheck = CheckDigit(strBar)
'Debug.Print dblBar
'Test the calculated check digit against the check digit enter with the barcode.
If strCheck = "Barcode Valid" Then
MsgBox (strCheck)
'Code here to do whatever it is you want with the valid barcode.
Else:
MsgBox (strCheck)
'Reopen barcode input box.
Call cmdBarcode_Click
End If
End If
End Sub
You will note that this doesn’t appear to do much. The real action is in the function CheckDigit(). You could put the code from CheckDigit() into the button’s OnClick event, but I prefer to put it in a module so that I can easily import it into other databases. In fact I tend to park any functions I might use elsewhere in a module I call BasicFunctionsRDM. You can place this code in any module you like.
Public Function CheckDigit(strBar As String)
'Copyright 2009 Cornell University Library.
'This code was originally written by Randall Miles, Technical Services Archivist.
'Kheel Center for Labor-Management Documentation and Archives.
'227 Ives Hall
'Cornell University
'Ithaca, NY 14853-3901
'Phone: 607-255-3183
'Fax: 607-255-9641
'E-mail: kheel_center@cornell.edu
'http://www.ilr.cornell.edu/library/kheel/
'You are free to use this code for any non-commercial purpose
'provided this copyright notice is left unchanged.
'To use this code for a commercial purposes contact
'Cornell University Library to obtain permission.
'This function verifies that the Codabar type barcode,
'the type commonly used in libraries, is correct.
Dim int01 As Integer 'Variable for first digit in barcode.
Dim int02 As Integer 'Second digit.
Dim int03 As Integer 'And so on.
Dim int04 As Integer
Dim int05 As Integer
Dim int06 As Integer
Dim int07 As Integer
Dim int08 As Integer
Dim int09 As Integer
Dim int10 As Integer
Dim int11 As Integer
Dim int12 As Integer
Dim int13 As Integer
Dim int14 As Integer 'Variable for the check digit in the barcode.
Dim dblSum As Double 'Variable used to calculate the check digit.
'Parse out the individual digits of the barcode.
'Digits in the odd places (1, 2, 5, 7, 11, 13) are multiplied by 2.
'Digits in the even places are not multiplied.
'If any multiplied digit is greater than 9 subtract 9 from it.
int01 = 2 * Mid(strBar, 1, 1)
If int01 > 9 Then
int01 = int01 - 9
Else:
int01 = int01
End If
int02 = Mid(strBar, 2, 1)
int03 = 2 * Mid(strBar, 3, 1)
If int03 > 9 Then
int03 = int03 - 9
Else:
int03 = int03
End If
int04 = Mid(strBar, 4, 1)
int05 = 2 * Mid(strBar, 5, 1)
If int05 > 9 Then
int05 = int05 - 9
Else:
int05 = int05
End If
int06 = Mid(strBar, 6, 1)
int07 = 2 * Mid(strBar, 7, 1)
If int07 > 9 Then
int07 = int07 - 9
Else:
int07 = int07
End If
int08 = Mid(strBar, 8, 1)
int09 = 2 * Mid(strBar, 9, 1)
If int09 > 9 Then
int09 = int09 - 9
Else:
int09 = int09
End If
int10 = Mid(strBar, 10, 1)
int11 = 2 * Mid(strBar, 11, 1)
If int11 > 9 Then
int11 = int11 - 9
Else:
int11 = int11
End If
int12 = Mid(strBar, 12, 1)
int13 = 2 * Mid(strBar, 13, 1)
If int13 > 9 Then
int13 = int13 - 9
Else:
int13 = int13
End If
int14 = Mid(strBar, 14, 1)
'Add digits 1 through 13 together.
dblSum = int01 + int02 + int03 + int04 + int05 + int06 + int07 + int08
dblSum = dblSum + int09 + int10 + int11 + int12 + int13
'Debug.Print dblSum
'If the sum is evenly divisible by 10 then the check digit equals 0.
'Otherwise take the remainder from the division add
'subtract it from 10 to get the check digit.
If Right(dblSum, 1) = 0 Then
dblSum = 0
Else:
dblSum = Right(dblSum / 10, 1)
dblSum = 10 - dblSum
End If
'Debug.Print dblSum
If dblSum = int14 Then
CheckDigit = "Barcode Valid"
Else:
CheckDigit = "Invalid Barcode"
End If
End Function
No comments:
Post a Comment