全てのプリンター名を取得したい

質問

エクセルで全てのプリンターのプリンター名・ドライバー名・ポート名を取得する コードを実行したいのですが

Sub Sample()
Dim prtLoop As Printer

For Each prtLoop In Application.Printers
With prtLoop
Debug.Print "Device name: " & .DeviceName
Debug.Print "Driver name: " & .DriverName
Debug.Print "Port: " & .Port
End With
Next prtLoop
End Sub

これをそのまま貼り付けて実行しようとすると、
「prtLoop As Printer」が、ユーザー定義型は定義されていません。
になります。

何に参照設定すればいいのかわからないので、
とりあえず
Dim prtLoop As Object
にしたのですが、
今度は
For Each prtLoop In Application.Printers
で
実行時エラー438
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
になります。

どうすればいいか教えてください。

回答No.2

NotFound404 · ベストアンサー

AccessならPrinterオブジェクトが使えますが、Excelにはありません。
参考にされたVBAはAccessのでは？
Accessがインストールされているなら
Sub Accで
Dim Acc As Object
Set Acc= Createobject("Access.application")
Debug.print Acc.Printers.count,Acc.printers(1).devicename
set Acc=nothing
end sub
のような感じで出来るかと思いますが、Accessが無い場合にはWMIで

Sub WMIで()
Dim strComputer As String
Dim objWMIService As Object
Dim colPrinters As Object
Dim objPrinter As Object
Dim objProperty As Object
Dim j As Integer

On Error Resume Next
strComputer = "." '自身のPC
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set colPrinters = objWMIService.ExecQuery _
("Select drivername,portname from Win32_Printer") '質問用
'Set colPrinters = objWMIService.ExecQuery _
("Select * from Win32_Printer") '参考用、上と切り替えてみて

For Each objPrinter In colPrinters
Debug.Print objPrinter.deviceid
j = j + 1
For Each objProperty In objPrinter.properties_
Debug.Print , objProperty.Name, objProperty.Value
j = j + 1
Cells(j, 1) = objProperty.Name
Cells(j, 2) = objProperty.Value
Next
Next
Set colPrinters = Nothing: Set objWMIService = Nothing
End Sub

※
"Select drivername,portname from Win32_Printer" で
drivername と portname だけをSelect してるのですが
シートにはDeviceNameも乗っかってきます。
WMIの仕様なのかは不明です。
「主キー」に相当するのが、DeviceName かも？
環境（OS/Excelのバージョン）によっては動かないかもです。

回答No.1

mitarashi

これはVBAではなく、VBのコードでは？
VBAにはPrinterオブジェクトはないので無理だと思います。
下記に、レジストリから取得する方法があります。
http://blogs.yahoo.co.jp/bardiel_of_may/40864687.html

For i = 0 To ctr - 1
sTemp1 = RegRead_API(HKEY_CURRENT_USER, SUB_ROOT, sPrinterList(i))
sTemp1 = Replace(sTemp1, "winspool,", "")
Debug.Print sPrinterList(i) & " on " & sTemp1
' sTemp2 = sTemp2 & sPrinterList(i) & " on " & sTemp1 & ","
Next

と改造すると、イミディウェイトウィンドウに、
Microsoft XPS Document Writer on Ne00:
といった形で取得出来ます。
Windwow7Home-64bit/xl2010-32bitで動作しました。
ご参考まで。