使用 Excel VBA 列出打印机时遇到问题

Question

原来的问题是这样的：

我有一个 Excel 文件，其中的按钮运行是一个宏。此宏需要将 sheet 打印到 2 个独立的网络打印机。工作簿将运行在网络上的多台不同计算机上。

我当前的代码如下所示：

Application.ActivePrinter = "Printer-A on Ne02:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.ActivePrinter = "Printer-B on Ne05:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

问题在于 on Ne02: 和 on Ne05:。这些值因一台计算机而异。例如：

Ne03 上的打印机 A：
Ne02 上的打印机 B：
Ne07 上的打印机 A：
等等

我可以通过显示 "select a printer" 对话框并强制用户手动选择打印机来避免这个问题，但我更希望这是自动的。

我试过使用 Windows 脚本主机对象模型来列出所有打印机，如下所示：

Function FindPrinter(name As String)
    Dim nwo As New WshNetwork
    Dim i As Integer
    Dim fullName As String

    For i = 0 To (nwo.EnumPrinterConnections.Count / 2) - 1
        If InStr(nwo.EnumPrinterConnections(i * 2 + 1), name) > 0 Then
            fullName = nwo.EnumPrinterConnections(i * 2 + 1)
        End If
    Next i

    ' Returns the LAST printer that matches
    FindPrinter = fullName
End Function

Sub MyMacro()
    ActivePrinter = FindPrinter("Printer-A")
End Sub

但是这失败了。如果我查看 FindPrinter 的输出，它只返回字符串 "Printer-A" 而没有 "on Ne02:"

如何获得已安装打印机的完整列表，包括这个 "on NeXX:" 位？或者，我怎样才能将一台只知道其名称的打印机设置为活动状态？

Answer 1

连接是枚举的第一部分。本质上 .Item(i + 1) & " on ' & .Item(i)。在你的代码中，这将是，

fullName = nwo.EnumPrinterConnections(i * 2 + 1) & " on " & nwo.EnumPrinterConnections(i * 2)

您必须填写一份类似打印机的列表；目前，您只返回最后一场比赛。

Answer 2

运行底部的测试子：

Option Explicit
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234

Private Declare Function RegOpenKeyEx Lib "advapi32" _
    Alias "RegOpenKeyExA" ( _
    ByVal HKey As Long, _
    ByVal lpSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) As Long

Private Declare Function RegEnumValue Lib "advapi32.dll" _
    Alias "RegEnumValueA" ( _
    ByVal HKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpValueName As String, _
    lpcbValueName As Long, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    lpData As Byte, _
    lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal HKey As Long) As Long

Public Function GetPrinterFullNames() As String()
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long    ' index into Printers()
Dim HKey As Long    ' registry key handle
Dim Res As Long     ' result of API calls
Dim Ndx As Long     ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long    ' length of ValueName
Dim DataType As Long        ' registry value data type
Dim ValueValue() As Byte    ' byte array of registry value value
Dim ValueValueS As String   ' ValueValue converted to String
Dim CommaPos As Long        ' position of comma character in ValueValue
Dim ColonPos As Long        ' position of colon character in ValueValue
Dim M As Long               ' string index

' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"

PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)

' open the key whose values enumerate installed printers
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
    KEY_QUERY_VALUE, HKey)
' start enumeration loop of printers
Res = RegEnumValue(HKey, Ndx, ValueName, _
    ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
    M = InStr(1, ValueName, Chr(0))
    If M > 1 Then
        ' clean up the ValueName
        ValueName = Left(ValueName, M - 1)
    End If
    ' find position of a comma and colon in the port name
    CommaPos = InStr(1, ValueValue, ",")
    ColonPos = InStr(1, ValueValue, ":")
    ' ValueValue byte array to ValueValueS string
    On Error Resume Next
    ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
    On Error GoTo 0
    ' next slot in Printers
    PNdx = PNdx + 1
    Printers(PNdx) = ValueName & " on " & ValueValueS
    ' reset some variables
    ValueName = String(255, Chr(0))
    ValueNameLen = 255
    ReDim ValueValue(0 To 999)
    ValueValueS = vbNullString
    ' tell RegEnumValue to get the next registry value
    Ndx = Ndx + 1
    ' get the next printer
    Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
        0&, DataType, ValueValue(0), 1000)
    ' test for error
    If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
        Exit Do
    End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
' Return the result array
GetPrinterFullNames = Printers
End Function

Sub Test()
    Dim Printers() As String
    Dim N As Long
    Dim S As String
    Printers = GetPrinterFullNames()
    For N = LBound(Printers) To UBound(Printers)
        S = S & Printers(N) & vbNewLine
    Next N
    MsgBox S, vbOKOnly, "Printers"
End Sub

使用 Excel VBA 列出打印机时遇到问题

Trouble listing printers with Excel VBA

printing

excel

vba