RIALAB.

Excelのアクティブプリンタをプログラムで設定できるようにしようとしたときのメモです。

最初は、どの環境でも「Microsoft XPS Document Writer」をアクティブプリンタに切り替えて処理を行えるようにしたかっただけなのですが、なにやら面倒なことになってしまい、途中で「INIファイルで設定をできるようにすればよかったかなー」と思ったものの、いちおう最後まで仕上げることができました。

Windows 8/8.1以降のOSで、WMIを使いプリンタのポート名を取得しようとすると「PORTPROMPT:」と返ってきて、実際のポート名がわからないことがあります。

WMI経由でプリンタ情報を表示するプログラム:

' This software is distributed under the license of NYSL.
' ( http://www.kmonos.net/nysl/ )

    Public Sub PrintPrinterInfo()

        ' WMIにプリンタ情報(Win32_Printer)を問い合わせる
        Dim mos = New System.Management.ManagementObjectSearcher("select * from Win32_Printer")

        ' 取得した結果を一覧表示する
        For Each mo As Management.ManagementObject In mos.Get
            Debug.Print(mo.Item("Name") & "=>" & mo.Item("PortName"))
        Next

        mos.Dispose()

    End Sub

上記プログラムの実行結果:

Send To OneNote 2013=>nul:
Microsoft XPS Document Writer=>PORTPROMPT:
Microsoft Print to PDF=>PORTPROMPT:
Fax=>SHRFAX:

「Microsoft XPS Document Writer」「Microsoft Print to PDF」のポート名が、「PORTPROMPT:」になっています。

この情報をもとに「《プリンタ名》 on 《ポート名》」という形式を組み立て、たとえばExcel VBAのApplication.ActivePrinterプロパティに設定しようとすると、設定が反映されなかったり、エラーが発生したりして期待通りに動かないことがあります。
(資料によってはポート名が省略できる旨が記載されているものもありますが、プリンタによってはポート名まで指定しないと設定が完了しないようです。)
どうやら、Application.ActivePrinterプロパティでは、実際のポート名を設定しないとダメみたいです。

そこで、実際のポート名を取得するルーチンを作ってみました。

このルーチンを呼び出すと、プリンタ名とポート名をレジストリから取得しTupleに格納、Listに詰めて返します。

レジストリからでプリンタ・ポート情報を取得するプログラム:

' This software is distributed under the license of NYSL
' ( http://www.kmonos.net/nysl/ )

    ''' 

    ''' 登録されているプリンタとポートの一覧を取得する
    ''' 
    ''' 最初の要素にプリンタの名前、2番目の要素にポートの名前を格納したTupleのリスト
    Public Function GetPrinterAndPortList() As List(Of Tuple(Of String, String))

        Dim l As New List(Of Tuple(Of String, String))

        ' HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Devicesからプリンタとポートの一覧を取得
        Dim rkDevices As Microsoft.Win32.RegistryKey =
            Microsoft.Win32.Registry.CurrentUser.OpenSubKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\Devices", False)

        ' サブキーが見つからない場合、空のListを返し終了
        If rkDevices Is Nothing Then
            Return l
        End If

        ' 取得したサブキーから名前(プリンタ名)を順に走査し、レジストリ値を取得する
        For Each name In rkDevices.GetValueNames
            Dim value As String = rkDevices.GetValue(name)
            ' レジストリ値を区切り文字(",")で分割、2番目の要素がポート名
            Dim tokens = value.Split(",")
            ' タプルを作成し、リストに詰める
            l.Add(New Tuple(Of String, String)(name, tokens(1)))
        Next

        Return l

    End Function

取得した情報から適当なプリンタ名とポート番号を組み合わせて、「《プリンタ名》 on 《ポート名》」形式に整形し、Application.ActivePrinterプロパティに設定したところ、期待した通りの動作をするようになりました。