使用Excel VBA列出打印机时遇到问题
所以这是原来的问题：
我有一个运行macros的button的Excel文件。 该macros需要将工作表打印到2台独立的networking打印机。 该工作簿将在networking上的多个不同的计算机上运行。
我目前的代码如下所示：
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: 这些值因计算机而异。 例如：
- 打印机-A在Ne03上：
- Ne02上的打印机B：
- 打印机-A Ne07：
- 等等
我可以通过显示“select打印机”对话框并强制用户手动select打印机来绕过这个问题，但我更希望这是自动的。
我已经尝试使用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的输出，它只返回string“Printer-A”，而没有“on Ne02：”
如何获得已安装的打印机的完整列表，包括“on NeXX：”位？ 或者，也可以如何将打印机设置为只知道其名称？
在底部运行Test子项：
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
连接是枚举的第一部分。 基本上.Item(i + 1) & " on ' & .Item(i) 。在你的代码中，
fullName = nwo.EnumPrinterConnections(i * 2 + 1) & " on " & nwo.EnumPrinterConnections(i * 2)
您将不得不填写类似打印机的列表; 目前，你只是返回最后一场比赛。