Print Oracle Data to a Barcode Label with a Zebra Printer using VBS and Excel

12 12 2009

December 12, 2009

Here is the problem: You know how to query the database using a Windows Scripting Host VBS file, but you have no way to print a barcode label using the data to the networked Zebra label printer and there is no printer driver installed for the Zebra printer.  Fortunately, Zebra printers understand ZPL (Zebra Printer Langauge), so we are able to easily work around the issue of not having a driver for the printer installed.  The second problem is how do we send the print job to the printer?  This is where Excel comes to the rescue.  Excel is able to work with the Windows API to start and submit a print job to a printer that is not necessarily installed on the local computer.

First, the Windows Scripting Host VBS file (note that this uses a DLL that I wrote which hides the database name, username, and password, as well as simplifying the process of submitting SQL statements with bind variables to the database):

'PrintLabel.vbs
Dim intParentPartLine
Dim strRawText
Dim strSQL
Dim strWhereUsed
Dim snpData
Dim OracleSQL
Dim objExcel

On Error Resume Next

Set OracleSQL = CreateObject("VMDBOracle.SQLProcessor") 'This is my custom DLL
Set snpData = CreateObject("ADODB.Recordset")
Set objExcel = CreateObject("Excel.Application")

strOut = ""
With objExcel
    'Open the Excel file containing the macro functions
    .Workbooks.Open "C:\ExcelMacroFunction.xls"

    strRawText = "~SD25^XA" 'Set Darkness, Label start
    strRawText = strRawText & "^SZ2" 'Enable ZPL2
    strRawText = strRawText & "^JZ" 'Reprint on error
    strRawText = strRawText & "^PR8,8,8" 'Print speed 8" per second, 8" per sec slew, 8" per sec backfeed
    strRawText = strRawText & "^LH12,30" 'Label home position in pixels
    strRawText = strRawText & "^FO5,0^A0,40,40^FD" & ID & "^FS" 'Proportional font
    strRawText = strRawText & "^FO5,40^A0,20,20^FD" & DESCRIPTION & "^FS" 'Proportional font
    strRawText = strRawText & "^FO5,80^A0,15,15^FD**** WHERE USED ****^FS" ' 'Proportional font

    strSQL = "SELECT DISTINCT" & vbCrLf
    strSQL = strSQL & "  R.WORKORDER_BASE_ID AS TOP_PART_ID," & vbCrLf
    strSQL = strSQL & "  WO.PART_ID AS SUB_PART_ID" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  REQUIREMENT R," & vbCrLf
    strSQL = strSQL & "  WORK_ORDER WO" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
    strSQL = strSQL & "  WO.TYPE='M'" & vbCrLf
    strSQL = strSQL & "  AND R.WORKORDER_TYPE='M'" & vbCrLf
    strSQL = strSQL & "  AND R.PART_ID= ?" & vbCrLf
    strSQL = strSQL & "  AND R.WORKORDER_TYPE=WO.TYPE" & vbCrLf
    strSQL = strSQL & "  AND R.WORKORDER_BASE_ID=WO.BASE_ID" & vbCrLf
    strSQL = strSQL & "  AND R.WORKORDER_LOT_ID=WO.LOT_ID" & vbCrLf
    strSQL = strSQL & "  AND R.WORKORDER_SPLIT_ID=WO.SPLIT_ID" & vbCrLf
    strSQL = strSQL & "  AND R.WORKORDER_SUB_ID=WO.SUB_ID" & vbCrLf
    strSQL = strSQL & "ORDER BY" & vbCrLf
    strSQL = strSQL & "  R.WORKORDER_BASE_ID," & vbCrLf
    strSQL = strSQL & "  WO.PART_ID"
    OracleSQL.SQL = strSQL
    OracleSQL.SetParameter ID, "VARCHAR"

    Set snpData = OracleSQL.Execute

    If Not (snpData Is Nothing) Then
        If Not (snpData.EOF) Then
            intParentPartLine = 0
            Do While Not (snpData.EOF)
                intParentPartLine = intParentPartLine + 1
                If snpData("top_part_id") <> snpData("sub_part_id") Then
                    strWhereUsed = strWhereUsed & cStr(snpData("top_part_id")) & " (Sub " & cStr(snpData("sub_part_id")) & ")"
                Else
                    strWhereUsed = strWhereUsed & cStr(snpData("top_part_id"))
                End If
                strRawText = strRawText & "^FO10," & cStr(80 + 25 * intParentPartLine) & "^A0,25,25^FD" & strWhereUsed & "^FS" 'Proportional font
                strWhereUsed  = ""

                snpData.MoveNext
            Loop
        End If

        snpData.Close
    End If

    strRawText = strRawText & "^FO20,562^AF^FDMy Company Here^FS"
    strRawText = strRawText & "^XZ"  'End of label indicator

    'Excute a macro located in mdlGlobal that prints a label using API calls
                                 'Subroutine, printer device name, raw ZPL code

    'Print to a shared Zebra printer named ZEBRA on computer named KMMACH98
    'strResult = .Application.Run("ZebraPrintLabel", "\\KMMACH98\ZEBRA", strRawText)

    'Print to a "Local" printer named ZEBRA_M1 with a redirected LTP2 port with NET USE
    strResult = .Application.Run("ZebraPrintLabel", "ZEBRA_M1", strRawText)

    .DisplayAlerts = False
    .ActiveWorkbook.Saved = True
    .Quit
End With

Set objExcel = Nothing 
Set OracleSQL = Nothing
Set snpData = Nothing
'End of PrintLabel.vbs

The above script expects to find an Excel spreadsheet named C:\ExcelMacroFunction.xls with a public subroutine named  ZebraPrintLabel in a regular Excel code module.

The code in the Excel code module looks like this:

'mdlGlobal in C:\ExcelMacroFunction.xls - a global module
Option Explicit

'Type declaration for Zebra label printing
Public Type DOC_INFO_1
    pDocName As String
    pOutputFile As String
    pDatatype As String
End Type

'Zebra Printing API functions
Public Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long
Public Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pDocInfo As DOC_INFO_1) As Long
Public Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long

Public Sub ZebraPrintLabel(strPrinter As Variant, strRawText As Variant)
    'Variables for handling printing
    Dim i As Integer
    Dim lngPrinterHandle As Long
    Dim lngResult As Long
    Dim lngWritten As Long
    Dim lngPrinterDocHandle As Long
    Dim bytRawText() As Byte
    Dim MyDocInfo As DOC_INFO_1

    On Error Resume Next

    'In VB6 to see the list of printer device names, enter the following into the Debug window
    'For i = 0 to Printers.Count - 1:Debug.Print Printers(i).DeviceName:Next

    'Sample label for testing using just Excel
    'strPrinter = "\\KMMACH98\ZEBRA"
    'strRawText = "~SD25^XA" 'Set Darkness, Label start
    'strRawText = strRawText & "^SZ2" 'Enable ZPL2
    'strRawText = strRawText & "^JZ" 'Reprint on error
    'strRawText = strRawText & "^PR8,8,8" 'Print speed 8" per second, 8" per sec slew, 8" per sec backfeed
    'strRawText = strRawText & "^LH10,26" 'Label home position in pixels
    'strRawText = strRawText & "^FO2,14^A0R,20,20^FDMy Company Here^FS" 'rotated text in font A
    'strRawText = strRawText & "^FO2,480^A0R,20,20^FDSomwhere, USA^FS"
    'strRawText = strRawText & "^FO180,135^B3R,,105,N^FD" & "ABC111" & "^FS"  'Font 3 of 9 barcode
    'strRawText = strRawText & "^FO180,0^GB0,760,3^FS"  'Vertical Line 3 pixels wide
    'strRawText = strRawText & "^FO335,0^GB0,1218,3^FS"  'Vertical Line 3 pixels wide
    'strRawText = strRawText & "^FO550,0^GB0,1218,3^FS"  'Vertical Line 3 pixels wide
    'strRawText = strRawText & "^FO260,760^GB0,452,3^FS"  'Vertical Line 3 pixels wide
    'strRawText = strRawText & "^FO0,760^GB335,0,3^FS"  'Horizontal Line 3 pixels wide
    'strRawText = strRawText & "^XZ"  'End of label indicator
    'Convert the variant data types to strings
    strPrinter = CStr(strPrinter)
    strRawText = CStr(strRawText)

    'Terminate the string with a CRLF combination (may not be needed)
    If Right(strRawText, 2) <> vbCrLf Then
        strRawText = strRawText & vbCrLf
    End If

    'Convert the strRawText string to a byte stream
    ReDim bytRawText(1 To Len(strRawText))
    For i = 1 To Len(strRawText)
        bytRawText(i) = Asc(Mid(strRawText, i, 1))
    Next i

    'Create a connection to the printer, returns a handle to the printer
    lngResult = OpenPrinter(strPrinter, lngPrinterHandle, 0)

    If lngPrinterHandle = 0 Then
        MsgBox "Could Not Open Printer"
        Exit Sub
    End If

    'Fill in the document header structure
    MyDocInfo.pDocName = "Zebra Label from Excel"
    MyDocInfo.pOutputFile = vbNullString
    MyDocInfo.pDatatype = "RAW"
    lngPrinterDocHandle = StartDocPrinter(lngPrinterHandle, 1, MyDocInfo)

    If lngPrinterDocHandle = 0 Then
        MsgBox "Could Not Start the Document"
        lngResult = ClosePrinter(lngPrinterHandle)
        Exit Sub
    End If

    'Prepare to start the first page
    Call StartPagePrinter(lngPrinterHandle)

    'Write out the contents of the first page
    lngResult = WritePrinter(lngPrinterHandle, bytRawText(1), Len(strRawText), lngWritten)
    If lngResult = 0 Then
        MsgBox "Could Not Write to the Page"
        lngResult = ClosePrinter(lngPrinterHandle)
        Exit Sub
    End If

    'End the first page
    lngResult = EndPagePrinter(lngPrinterHandle)

    'End the document
    lngResult = EndDocPrinter(lngPrinterHandle)

    'Close the connection to the printet
    lngResult = ClosePrinter(lngPrinterHandle)
End Sub
'End of mdlGlobal

Note that while the above uses a custom DLL to connect to the database and submit SQL statements, the Simple VBS Script to Retrieve Data from Oracle blog entry shows how to do the same without using the custom DLL.  Also, it probably is not necessary to convert the Unicode string that is passes into the procedure into a byte stream for the Windows API call.

The printed label appears below:

« »


Actions

Information

  • Date : December 12, 2009
  • Categories : Excel, VBS

Leave a comment