Skip to content

Instantly share code, notes, and snippets.

@hasokeric
Created January 25, 2016 12:38
Show Gist options
  • Save hasokeric/24ec6c9fb1808f6686b9 to your computer and use it in GitHub Desktop.
Save hasokeric/24ec6c9fb1808f6686b9 to your computer and use it in GitHub Desktop.
BarTender Dealing with CBool use ABS()
'Called for every label that is printed.
'================================================
' Used to Set All Label Changes at once for speed
'================================================
Dim btNamedSubString
btNamedSubString = ""
'================================================
' Enable us to Catch Errors
'================================================
On Error Resume Next
' Reset our ERROR Text Object
'Format.NamedSubStrings("ERROR").Value = ""
btNamedSubString = btNamedSubString & "ERROR" & vbLf & "" & vbLf
Err.Clear
'================================================
' Initialize Variables
'================================================
Dim currentSerial, partNum, tranNum, hasConflicts, sQuery
'Get DB Fields
tranNum = Field("PartTran_TranNum")
partNum = Field("PartTran_PartNum")
hasConflicts = Abs(CBool(Field("PartTran_CheckBox05")))
'IF PartTran.Character09 != ""
' RUN QUERY( IF UD07.Key3 = PartTran.Character09 AND UD07.CheckBox01 = true ) /* Check if Serial is PACKED */
'THEN
' DO _NOT_ Generate a Serial Number instead use PartTran.Character09 /* Given to us by Shipping */
If Field("PartTran_Character09") <> "" Then
objLog.WriteLine "PartTran_Character09 is NOT Empty: " & Field("PartTran_Character09")
currentSerial = Field("PartTran_Character09")
Set objRecordsetGetUD07 = CreateObject("ADODB.Recordset")
objRecordsetGetUD07.Open "SELECT * FROM PUB.UD07 WHERE Key3 = '" & currentSerial & "' AND ShortChar20 = 'PACK' ORDER BY Number20 ASC", objConn, adOpenStatic, adLockOptimistic, adCmdText
If objRecordsetGetUD07.RecordCount > 0 Then
objRecordsetGetUD07.MoveLast
currentIndex = Int( objRecordsetGetUD07.Fields.Item("Key5") )
objLog.WriteLine "Char09 Records Found: " & objRecordsetGetUD07.RecordCount
btNamedSubString = btNamedSubString & "SERIAL" & vbLf & currentSerial & vbLf
btNamedSubString = btNamedSubString & "SerialNumIndex" & vbLf & "-" & currentIndex & vbLf
Format.NamedSubStrings.SetAll btNamedSubString, vbLf
objRecordsetGetUD07.Close
Exit Sub
End If
objRecordsetGetUD07.Close
End If
' Open Recordset for Writing to UD07
Set objRecordset = CreateObject("ADODB.Recordset")
'================================================
' Generate a Serial Number
'================================================
Set objRecordsetSNGen = CreateObject("ADODB.Recordset")
currentSerial = GetNextUsableSerialNumber(objRecordsetSNGen, currentIndex)
objLog.WriteLine "Database Suggested Serial Number: " & currentSerial
'================================================
' Verify Serial Number to make sure its not used
'================================================
Set objRecordsetSerialCheck = CreateObject("ADODB.Recordset")
Dim sVerify
sVerify = CheckSerial(objRecordsetSerialCheck, currentSerial)
while sVerify > 0
objLog.WriteLine "UH-OH! Duplicate Found... try creating a new serial number"
objLog.WriteLine "Previous SN: " & currentSerial
currentSerial = currentSerial + 1
objLog.WriteLine "New SN: " & currentSerial
' RE-Test
sVerify = CheckSerial(objRecordsetSerialCheck, currentSerial)
Wend
If Format.IsPrinting = True And Format.IsPrintPreview = False Then
'Prep Query
sQuery = "INSERT INTO PUB.UD07 (Company, Key1, Key2, Key3, Key5, Date01, ShortChar01, ShortChar02, Number09, Number20, CheckBox05) VALUES ('DIEN', '" & tranNum & "', '" & partNum & "', '" & currentSerial & "', '" & currentIndex & "', '" & NOW() & "', 'PartTran', 'GRUPOMarlette', 200, " & currentSerial & ", " & hasConflicts & ")"
'Log Query
objLog.WriteLine sQuery
'Execute Query
objRecordset.Open sQuery, objConn, adOpenStatic, adLockOptimistic, adCmdText
End If
'================================================
' Change the Serial Number on the BARCODE
'================================================
btNamedSubString = btNamedSubString & "SERIAL" & vbLf & currentSerial & vbLf
btNamedSubString = btNamedSubString & "SerialNumIndex" & vbLf & "-" & currentIndex & vbLf
'================================================
' Increment our Index
'================================================
currentIndex = currentIndex + 1
'================================================
' Check for ERRORS
'================================================
If Err.Number <> 0 Then
objLog.WriteLine "BT LOG ERROR IC: " & Err.Description
Format.NamedSubStrings("ERROR").Value = "ERROR! REPRINT"
Format.CancelPrinting("Query Error! - " & Err.Description)
End If
'================================================
' Change All Values Now
'================================================
Format.NamedSubStrings.SetAll btNamedSubString, vbLf
On Error Goto 0
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment