Excel VBA：PrintOut无需端口设打印机，提前设ActivePrinter遇1004错误

问题背景 #

现有一个Excel VBA宏，通过用户选择设置打印机并执行打印：

• 在PrintOut方法中传入不带端口的网络打印机名（如\\PRINTSERVER2\Printer2）即可正常打印，执行后Application.ActivePrinter会自动补全端口信息（如\\PRINTSERVER2\Printer2 on Ne23:）。
• 但直接给Application.ActivePrinter赋值不带端口的打印机名时，会触发Runtime Error '1004': Method 'ActivePrinter' of object '_Application' failed错误，必须手动添加端口名才能成功赋值。

需求是提前设置ActivePrinter，避免打印机连接丢失时宏默认使用错误打印机浪费纸张，同时希望找到无需手动获取端口名的实现方法，并理解背后的机制。

现有代码示例 #

可正常运行的代码 #

' 用户在工作表标记单元格选择打印机后运行宏
Dim printerChoice() As Variant ' 存储用户选择打印机的单元格值
Dim printer As String

With ThisWorkbook.Sheets("Sheet1")
    printerChoice = .Range("G1:G5").Value ' 将打印机选择区域复制到数组
End With

For i = LBound(printerChoice, 1) To UBound(printerChoice, 1)
    If printerChoice(i, 1) <> "" Then ' 如果当前打印机被选中
        j = j + 1
        Select Case i
            Case 1: printer = "\\PRINTSERVER2\Printer1"
            Case 2: printer = "\\PRINTSERVER2\Printer2"
            Case 3: printer = "\\PRINTSERVER2\Printer3"
            Case 4: printer = "\\PRINTSERVER2\Printer4"
            Case 5: printer = "\\PRINTSERVER2\Printer5"
        End Select
    End If
Next i

' 此处为其他业务代码

With ThisWorkbook.Sheets("Sheet1")
    ' 设置打印区域代码
    .PrintOut copies:=1, Collate:=False, ActivePrinter:=printer
    ' 执行后，printer仍为不带端口的名称，但Application.ActivePrinter已自动补全端口
End With

触发错误的代码（提前设置ActivePrinter） #

' 与上述代码相同的初始化部分...

Next i

' 尝试提前设置ActivePrinter，触发1004错误
Application.ActivePrinter = printer

' 此处为其他业务代码

With ThisWorkbook.Sheets("Sheet1")
    ' 设置打印区域代码
    .PrintOut copies:=1, Collate:=False
End With

仅添加端口名可正常运行的代码 #

Application.ActivePrinter = printer & " on portname:"

机制解析 #

• PrintOut方法内部会调用系统打印API，自动匹配并补全打印机的端口信息，因此只需传入打印机的网络名称即可。
• Application.ActivePrinter属性要求必须赋值系统中存在的完整打印机标识——Windows系统中显示的打印机名称格式为打印机名 on 端口:，直接传入不完整的名称时，Excel无法找到匹配的打印机，因此抛出错误。

无需手动获取端口名的解决方案 #

通过遍历Application.Printers集合，匹配目标打印机的网络名称，自动获取带端口的完整打印机名称：

获取完整打印机名称的函数 #

Function GetFullPrinterName(targetPrinter As String) As String
    Dim prt As Printer
    ' 遍历系统中所有可用打印机
    For Each prt In Application.Printers
        ' 匹配目标打印机的网络名称部分（避免端口干扰）
        If InStr(prt.Name, targetPrinter) > 0 Then
            GetFullPrinterName = prt.Name
            Exit Function
        End If
    Next prt
    ' 未找到时返回空字符串
    GetFullPrinterName = ""
End Function

修改后的调用代码 #

' 与上述代码相同的初始化部分...

Next i

' 获取完整打印机名称并设置ActivePrinter
Dim fullPrinterName As String
fullPrinterName = GetFullPrinterName(printer)
If fullPrinterName <> "" Then
    Application.ActivePrinter = fullPrinterName
Else
    MsgBox "指定打印机未找到或未连接，请检查后重试"
    Exit Sub
End If

' 此处为其他业务代码

With ThisWorkbook.Sheets("Sheet1")
    ' 设置打印区域代码
    .PrintOut copies:=1, Collate:=False
End With

这样既实现了提前设置打印机的需求，又无需手动获取端口名，同时还能在打印机未连接时提前报错，避免浪费纸张。

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