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:

Recent Comments