Problem : Create a Module for ZPL (Zebra Printer) in VBA (Access)
I need to create a Module (or create code that can be duplicated/edited for each different label) for ZPL in VBA (Access). Is this possible (Examples?)
Currently I’m printing 2″ x 4″ labels on an Avery Label (HP Printer), I switching the application to a Zebra Z4MPlus printer. I’m being told that I should use a Third-Party software application to developed these labels and then print them on the Zebra.
I’ll admit that I’m not familiar with the ZPL language, pretty good with VBA and understand that there are limitations. The labels print very simple data from my query. (All Text fields). I don’t need barcoding at this time.
My concern is that if I use Third-party software I’m just complicating an issue that might have a simple solution!
One is it possible? (Biggest Issue Zebra printers don’t handle the TrueFonts well, or so I’m told).
If possible, can you help? (I know that is two question, but I’m really asking the same thing twice).
Solution : Create a Module for ZPL (Zebra Printer) in VBA (Access)
Here goes, its quite involved, perhaps there is a simpilier process, but this works and made sense to me…
‘ First you have to create the data, I did this through a SQL that I generate on a select form. Then that data is sent to the
‘ function fncProvideQueryData which then create the data string, place the field of the record into a temp table zDumpTable.
‘ See the following link for clarification of this process: http://www.experts-exchange.com/Databases/MS_Access/Q_21996973.html
‘ This is for the fncDirectPrint
Private Type DOCINFO
pDocName As String
pOutputFile As String
pDatatype As String
End Type
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
ByVal pDefault As Long) As Long
Private Declare Function StartDocPrinter Lib "winspool.drv" Alias _
"StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pDocInfo As DOCINFO) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, _
pcWritten As Long) As Long
‘ Select a printer
Public Function fncSpecifyPrinter()
On Error GoTo Err_fncSpecifyPrinter
‘To set a printer to a specific printer
Dim PrTest As Printer
For Each PrTest In Printers
If PrTest.DeviceName = "\\HQSNKFPS01\Pharmacy Label Printer (Zebra Z4M)" Then ‘Zebra Z4M
Set Printer = PrTest
Exit For
End If
Next
Exit_fncSpecifyPrinter:
Exit Function
Err_fncSpecifyPrinter:
Call GblErrHandle(Err.Description, Err.Number, "modZebra", "n/a", Erl)
Resume Exit_fncSpecifyPrinter
End Function
‘ Get the Data
Public Function fncProvideQueryData(strSelect As String, intValue As Integer) ‘ intValue is the Value of the Group that call the function
On Error GoTo Err_fncProvideQueryData
Dim strDeleteData As String
‘ Delete data that is already in zTableDump
strDeleteData = "DELETE zDumpTable.Fld1 FROM zDumpTable;"
‘Reminder to Turn Warning off When Complete
DoCmd.SetWarnings False
‘ Output to Query?
CurrentDb.QueryDefs("qryTemp").Sql = strDeleteData
DoCmd.OpenQuery "qryTemp"
DoCmd.SetWarnings True
‘ Code from Capricorn1 from EE
Dim rs As dao.Recordset, rs1 As dao.Recordset
Dim strCohort As String
Set rs1 = CurrentDb.OpenRecordset("zDumpTable", dbOpenDynaset)
Set rs = CurrentDb.OpenRecordset(strSelect)
If rs.EOF Or rs.BOF Then Exit Function
rs.MoveFirst
Do Until rs.EOF
With rs1
.AddNew
!Fld1 = rs(0)
.Update
.AddNew
!Fld1 = rs(1)
.Update
.AddNew
!Fld1 = rs(2)
.Update
.AddNew
!Fld1 = rs(3)
.Update
.AddNew
!Fld1 = rs(4)
.Update
.AddNew
!Fld1 = rs(5)
.Update
.AddNew
!Fld1 = rs(6)
.Update
.AddNew
!Fld1 = rs(7)
.Update
.AddNew
!Fld1 = rs(8)
.Update
.AddNew
!Fld1 = rs(9)
.Update
.AddNew
!Fld1 = rs(10)
.Update
.AddNew
End With
‘ Create Cohort / Period Use as rs(3) for all Labels that require both
strCohort = rs(3) & " Period " & rs(4)
‘MsgBox rs(0) & " | " & rs(1) & " | " & rs(2) & " | " & rs(3) & " | " & rs(4) & " | " & rs(5) & " | " & rs(6) & " | " & rs(7) & _
" | " & Nz(rs(8), "_______") & " | " & rs(9) & " | " & rs(10) & " | " & strDrug1 & " | " & strDrug2
Select Case intValue
Case 40: ‘ Send data to printer 4" x 4" (Cohort, Period)
Call fncZebraPrintD(rs(0), rs(1), rs(2), strCohort, rs(4), rs(5), rs(6), rs(7), Nz(rs(8), "_______"), rs(9), rs(10))
Case 41: ‘ Send data to printer 4" x 2"
MsgBox "4 x 2 Labels are not in the Printer", , "Oops"
‘Call fncZebraPrintS(rs(0), rs(1), rs(2), strCohort, rs(4), rs(5), rs(6), rs(7), Nz(rs(8), "_______"), rs(9), rs(10))
End Select
‘ Move to next record in recordset
rs.MoveNext
Loop
Exit_fncProvideQueryData:
Exit Function
Err_fncProvideQueryData:
Call GblErrHandle(Err.Description, Err.Number, "modZebraPrintLabels", "n/a", Erl)
Resume Exit_fncProvideQueryData
End Function
‘ Goal is to create a function that will take data from the label, generate a data stream and then output to a Zebra Z4MPlus printer
‘ Create the Data String
Public Function fncZebraPrintS(strSponsor As String, strProtocol As String, strNWK As String, strCohort As String, strPeriod As String, _
dtDoseDate As String, dtPrepDate As String, strRand As String, strSubject As String, strDoseTime As String, strDrug As String)
On Error GoTo Err_fncZebraPrintS
‘^LH0,0 is the home position, ^LL800 the size of the label in points, ^FWB – Rotates data 270 degrees, ^FW800 – denotes width of 800 dots
Dim strData As String
‘ This code produces a single label 4" x 2" with Cohort, Period
strData = "^XA^FWI,^LH0,0^LL800,^PW800,^CF0,30" & _
"^FO350,10 ^A0N,32,32 ^FDProtocol:^FS, ^FO500,10 ^A0N,32,32 ^FV" & strProtocol & "^1,1^FS" & _
"^FO350,50 ^A0N,32,32 ^FDNWK:^FS, ^FO500,50 ^A0N,32,32 ^FV" & strNWK & "^1,1^FS" & _
"^FO350,90 ^A0N,32,32 ^FDCohort:^FS, ^FO450,90 ^A0N,32,32 ^FV" & strCohort & "^1,1^FS" & _
"^FO525,90 ^A0N,32,32 ^FDPeriod:^FS, ^FO625,90 ^A0N,32,32 ^FV" & strPeriod & "^1,1^FS" & _
"^FO350,130 ^A0N,32,32 ^FDPrep Date:^FS,^FO500,130 ^A0N,32,32 ^FV" & dtPrepDate & "^1,^1^FS" & _
"^FO350,170 ^A0N,32,32 ^FDPrep By: ____ / ____^FS," & _
"^FO15,10 ^A0N,32,32 ^FV" & strSponsor & "^1,^1^FS" & _
"^FO15,90 ^A0N,32,32 ^FDRand #:^FS, ^FO160,90 ^A0N,32,32 ^FV" & strRand & "^1,^1^FS" & _
"^FO15,130 ^A0N,32,32 ^FDSubject:^FS, ^FO160,130 ^A0N,32,32 ^FV" & strSubject & "^1,^1^FS" & _
"^FO15,170 ^A0N,32,32 ^FDDose Date:^FS,^FO160,170 ^A0N,32,32 ^FV" & dtDoseDate & "^1,1^FS" & _
"^FO15,210 ^A0N,32,32 ^FDDose Time:^FS,^FO160,210 ^A0N,32,32 ^FV" & strDoseTime & "^1,1^FS" & _
"^FB768,3,," & _
"^FO15,250 ^A0N,32,32 ^FV" & strDrug & "^1,1^FS" & _
"^FO100,330 ^A0N,36,36 ^FDFOR INVESTIGATIONAL USE ONLY^1,1^FS" & _
"^FO100,360 ^GB550,0,4^FS" & _
"^PQ1,0,1,Y^XZ"
Call fncDirectPrint(strData)
Exit_fncZebraPrintS:
Exit Function
Err_fncZebraPrintS:
Call GblErrHandle(Err.Description, Err.Number, "modZebra", "n/a", Erl)
Resume Exit_fncZebraPrintS
End Function
‘ Send it to Printer
Public Function fncDirectPrint(strData As String)
On Error GoTo Err_fncDirectPrint
‘ Call function to choose specific printer
Call fncSpecifyPrinter
‘ Obtained the following code from the listed Microsoft site, it prints directly to the printer.
‘ http://support.microsoft.com/kb/q154078/
‘ How To Send Raw Data to a Printer Using the Win32 API from Visual Basic
Dim lhPrinter As Long
Dim lReturn As Long
Dim lpcWritten As Long
Dim lDoc As Long
Dim sWrittenData As String
Dim MyDocInfo As DOCINFO
lReturn = OpenPrinter(Printer.DeviceName, lhPrinter, 0)
If lReturn = 0 Then
MsgBox "The Printer Name you typed wasn’t recognized."
Exit Function
End If
MyDocInfo.pDocName = "AAAAAA"
MyDocInfo.pOutputFile = vbNullString
MyDocInfo.pDatatype = vbNullString
lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo)
Call StartPagePrinter(lhPrinter)
sWrittenData = strData & vbFormFeed ‘"How’s that for Magic !!!!" & vbFormFeed
lReturn = WritePrinter(lhPrinter, ByVal sWrittenData, _
Len(sWrittenData), lpcWritten)
lReturn = EndPagePrinter(lhPrinter)
lReturn = EndDocPrinter(lhPrinter)
lReturn = ClosePrinter(lhPrinter)
‘ Call function to return to default printer
Call fncDefaultPrinter
Exit_fncDirectPrint:
Exit Function
Err_fncDirectPrint:
Call GblErrHandle(Err.Description, Err.Number, "modZebraPrintLabels", "n/a", Erl)
Resume Exit_fncDirectPrint
End Function
