Access VBA向EOM-200 V1.2打印机发十进制码开钱箱求助

问题原因 #

你之前的代码失效大概率是因为打印机使用USB端口（或非直接可读写的虚拟端口），Open Application.Printer.Port For Output这种方式仅适用于传统串口/并口，对USB虚拟端口无效，必须通过Windows打印API发送原始控制指令。

可行解决方案：使用Win32API发送原始打印数据 #

以下是完整的VBA代码实现，直接调用Windows打印API发送指定的控制码：

Option Explicit

' 声明Win32API函数
Private Declare PtrSafe Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As LongPtr, pDefault As Any) As Long
Private Declare PtrSafe Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As LongPtr, ByVal Level As Long, pDocInfo As Any) As Long
Private Declare PtrSafe Function StartPagePrinter Lib "winspool.drv" (ByVal hPrinter As LongPtr) As Long
Private Declare PtrSafe Function WritePrinter Lib "winspool.drv" (ByVal hPrinter As LongPtr, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long
Private Declare PtrSafe Function EndPagePrinter Lib "winspool.drv" (ByVal hPrinter As LongPtr) As Long
Private Declare PtrSafe Function EndDocPrinter Lib "winspool.drv" (ByVal hPrinter As LongPtr) As Long
Private Declare PtrSafe Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As LongPtr) As Long

' 文档信息结构体
Private Type DOC_INFO_1
    pDocName As String
    pOutputFile As String
    pDataType As String
End Type

Public Sub OpenCashDrawer()
    Dim hPrinter As LongPtr
    Dim docInfo As DOC_INFO_1
    Dim bytesWritten As Long
    Dim success As Long
    Dim printerName As String
    Dim controlBytes() As Byte
    
    ' 指定打印机名称
    printerName = "EOM-200 V1.2"
    
    ' 定义钱箱控制码：十进制27、112、0、127、127
    controlBytes = Chr(27) & Chr(112) & Chr(0) & Chr(127) & Chr(127)
    
    ' 打开打印机
    success = OpenPrinter(printerName, hPrinter, ByVal 0&)
    If success = 0 Then
        MsgBox "无法打开指定打印机", vbExclamation
        Exit Sub
    End If
    
    ' 设置文档信息
    docInfo.pDocName = "Cash Drawer Trigger"
    docInfo.pOutputFile = vbNullString
    docInfo.pDataType = "RAW" ' 关键：以原始数据模式发送
    
    ' 开始打印任务
    success = StartDocPrinter(hPrinter, 1, docInfo)
    If success = 0 Then
        ClosePrinter hPrinter
        MsgBox "无法启动打印任务", vbExclamation
        Exit Sub
    End If
    
    ' 开始打印页
    success = StartPagePrinter(hPrinter)
    If success = 0 Then
        EndDocPrinter hPrinter
        ClosePrinter hPrinter
        MsgBox "无法启动打印页", vbExclamation
        Exit Sub
    End If
    
    ' 发送控制码
    success = WritePrinter(hPrinter, controlBytes(0), UBound(controlBytes) + 1, bytesWritten)
    If success = 0 Or bytesWritten <> UBound(controlBytes) + 1 Then
        MsgBox "发送控制码失败", vbExclamation
    End If
    
    ' 结束打印页和任务，关闭打印机
    EndPagePrinter hPrinter
    EndDocPrinter hPrinter
    ClosePrinter hPrinter
End Sub

使用说明 #

• 确保在Access VBA编辑器中开启Option Explicit（避免变量名错误）。
• 若使用32位Access，将代码中的PtrSafe和LongPtr替换为Long（32位系统下二者等价）。
• 直接调用OpenCashDrawer子程序即可触发钱箱弹出。

替代方案：使用Printer对象的Raw模式（部分打印机支持） #

如果上述API方法仍有问题，可尝试修改原有代码，改用Printer对象的原始输出模式：

Public Sub OpenCashDrawerAlternative()
    Dim prt As Printer
    Dim controlStr As String
    
    controlStr = Chr(27) & Chr(112) & Chr(0) & Chr(127) & Chr(127)
    
    ' 遍历打印机找到目标设备
    For Each prt In Application.Printers
        If prt.DeviceName = "EOM-200 V1.2" Then
            Set Application.Printer = prt
            Exit For
        End If
    Next prt
    
    With Application.Printer
        .PrintRawData controlStr ' 关键：使用PrintRawData发送原始数据
    End With
    
    Set Application.Printer = Nothing
End Sub

注意：PrintRawData方法仅在部分Access版本和打印机驱动中支持，若你的Access版本无此方法，优先使用第一种API方案。

内容的提问来源于stack exchange，提问作者JED