Verify And Log Printed Labels? Follow

Legacy Poster

I have some simple labels that I use at work for asset tag that are just serialized in bartender but I've been having an issue lately where the labels have not been getting saved when people use them so now we have a duplicate issue. I would like to set up the labels so that before it prints it checks a text file or database to see if that number has been used before and cancels the print job if it has. If the label has not been used before then I would like it to log that number to the text file or database after it is printed so it won't be used again.


I'm in no way an expert on bartender or with VBscript so any help would be greatly appreciated.

I was able to achieve the cancel printing goal with the two code blocks below, but when it logs the values to a text file they are duplicated 19 time each.

The first one is just in the Functions section(found it online to read from an excel file) while the second one is in the OnPostSerialize section(this I kind of cobbled together from different sources).

Also I'm doing this with Bartender Enterprise Automation 10.1 SR3 but if there is a way to do it in Bartender version 9 too that would be really helpful otherwise I'll just have to add this to the list of reasons why we need to budget for more software upgrades.


Function ReadExcel( myXlsFile, mySheet, my1stCell, myLastCell, blnHeader )
' Function :  ReadExcel
' Version  :  3.00
' This function reads data from an Excel sheet without using MS-Office
' Arguments:
' myXlsFile   [string]   The path and file name of the Excel file
' mySheet     [string]   The name of the worksheet used (e.g. "Sheet1")
' my1stCell   [string]   The index of the first cell to be read (e.g. "A1")
' myLastCell  [string]   The index of the last cell to be read (e.g. "D100")
' blnHeader   [boolean]  True if the first row in the sheet is a header
' Returns:
' The values read from the Excel sheet are returned in a two-dimensional
' array; the first dimension holds the columns, the second dimension holds
' the rows read from the Excel sheet.
' Written by Rob van der Woude
    Dim arrData( ), i, j
    Dim objExcel, objRS
    Dim strHeader, strRange

    Const adOpenForwardOnly = 0
    Const adOpenKeyset      = 1
    Const adOpenDynamic     = 2
    Const adOpenStatic      = 3

    ' Define header parameter string for Excel object
    If blnHeader Then
        strHeader = "HDR=YES;"
        strHeader = "HDR=NO;"
    End If

    ' Open the object for the Excel file
    Set objExcel = CreateObject( "ADODB.Connection" )
    ' IMEX=1 includes cell content of any format; tip by Thomas Willig.
    ' Connection string updated by Marcel Niënkemper to open Excel 2007 (.xslx) files.
    objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                  myXlsFile & ";Extended Properties=""Excel 12.0;IMEX=1;" & _
                  strHeader & """"

    ' Open a recordset object for the sheet and range
    Set objRS = CreateObject( "ADODB.Recordset" )
    strRange = mySheet & "$" & my1stCell & ":" & myLastCell
    objRS.Open "Select * from [" & strRange & "]", objExcel, adOpenStatic

    ' Read the data from the Excel sheet
    i = 0
    Do Until objRS.EOF
        ' Stop reading when an empty row is encountered in the Excel sheet
        If IsNull( objRS.Fields(0).Value ) Or Trim( objRS.Fields(0).Value ) = "" Then Exit Do
        ' Add a new row to the output array
        ReDim Preserve arrData( objRS.Fields.Count - 1, i )
        ' Copy the Excel sheet's row values to the array "row"
        ' IsNull test credits: Adriaan Westra
        For j = 0 To objRS.Fields.Count - 1
            If IsNull( objRS.Fields(j).Value ) Then
                arrData( j, i ) = ""
                arrData( j, i ) = Trim( objRS.Fields(j).Value )
            End If
        ' Move to the next row
        ' Increment the array "row" number
        i = i + 1

    ' Close the file and release the objects
    Set objRS    = Nothing
    Set objExcel = Nothing

    ' Return the results
    ReadExcel = arrData
End Function


Dim arrSheet, intCount
Dim barvalue
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile("C:\Users\steve\Desktop\test.txt", 8, True)
barvalue = Format.NamedSubStrings("SNbarcode").Value
arrSheet = ReadExcel( "C:\Users\steve\Desktop\ALLIN1.xlsx", "Imports", "A2", "A21", True )
For intCount = 0 To UBound( arrSheet, 2 )
	If barvalue = arrSheet( 0, intCount ) Then
		Call UserMessage(btMsgSeverityInformation, "Match Found.")
		intCount = UBound( arrSheet, 2 )
    End If


Please sign in to leave a comment.