TOP > サンプル / 関数 > *      [...]

---

概要

Windows の通常使うプリンター（デフォルトプリンター）を変更します。

機能

1. 以下のコマンドを使って、Windowsの通常使うプリンターを変更します。 rundll32.exe printui.dll,PrintUIEntry /y /n "プリンター名"
2. 以下の操作をVBAプログラミングでコマンドライン実行したと同じことを行います。
   

   

形式

001 [Boolean] = SetDefaultPrinter( _ 002 sDefaultPrinter As String, _ 003 sErrMsg As String) As Boolean

引数

1. 第一引数 ( sDefaultPrinter As String ) :
   通常使うプリンター名をセットします。
2. 第二引数 ( sErrMsg As String ) :
   エラー時にエラーメッセージがセットされます。

戻り値

1. True : 正常終了。
2. False : エラー有り。第二引数のsErrMsgにエラーメッセージがセットされます。

サンプル

通常使うプリンター名を「Adobe PDF」に設定します。

※思ったほど、簡単では無い。本気でやると。

Download：sample-SetDefaultPrinter.xls

001 Option Explicit 002 003 '************************************************** 004 ' 005 ' テスト用メインルーチン 006 ' 007 ' 処理内容： 008 ' 通常使うプリンター名を"Adobe PDF"に設定する。 009 ' 010 '************************************************** 011 012 Sub Test_Main() 013 Dim bRet As Boolean 014 Dim sErrMsg As String 015 bRet = SetDefaultPrinter("Adobe PDF", sErrMsg) 016 Debug.Print "SetDefaultPrinter.bRet = " & bRet 017 MsgBox sErrMsg & vbCrLf & "bRet = (" & bRet & ")" & vbCrLf & Now 018 End Sub 019 020 021 '************************************************** 022 ' 023 ' 通常使うプリンターを変更 024 ' 025 ' 機能 : 通常使うプリンターを設定する。 026 ' 既に設定されているとエラーで返す。 027 ' 存在しないプリンター名はエラーで返す。 028 ' 029 ' Create : 2017/09/02 030 ' Update : 031 ' Vertion : 1.0 032 ' 033 ' 第１引数：sDefaultPrinter As String (In) 034 ' コマンドライン 035 ' 第２引数：sErrMsg As String (Out) 036 ' エラーメッセージ 037 ' 038 ' 戻り値 : True:正常終了 False:エラー発生 039 ' 040 ' 備考 : 他の関数も使用している。 041 ' URL : https://pdf-file.nnn2.com/?p=1018 042 ' その他 : 著作権等は主張しません。 043 ' 上記URLにコメントを頂けると嬉しいです。 044 ' 045 '************************************************** 046 047 Private Function SetDefaultPrinter( _ 048 ByVal sDefaultPrinter As String, _ 049 ByRef sErrMsg As String) As Boolean 050 051 If Trim$(sDefaultPrinter) = "" Then 052 'エラー：Not Found Printer name 053 SetDefaultPrinter = False 054 sErrMsg = "エラー：SetDefaultPrinter" & vbCrLf & _ 055 "プリンター名がセットされてない。" 056 Exit Function 057 End If 058 059 Dim i As Long 060 Dim bRet As Boolean 061 Dim strOutFile1() As String 062 Dim strOutFile2() As String 063 064 '引数で使う変数 065 Dim strCmd As String 066 Dim strOutFile(1) As String 067 Dim strErr As String 068 Dim strWorkFolder As String 069 Dim lRetCode As Long 070 Dim lErrCount As Long 071 Dim lErrCode(0) As Long 072 073 Dim strPrinterName() As String 074 Const CON_FOUND = 99999 075 076 'PCに登録されているプリンター名を全て取得する 077 bRet = nnn2GetAllPrinters(strPrinterName) 078 079 If sDefaultPrinter = strPrinterName(0) Then 080 '警告：It is already set. 081 SetDefaultPrinter = False 082 sErrMsg = "警告：SetDefaultPrinter" & vbCrLf & _ 083 "既に通常使うプリンターにセット済みです。" & vbCrLf & _ 084 "(" & sDefaultPrinter & ")" 085 Exit Function 086 End If 087 For i = 1 To UBound(strPrinterName) 088 If sDefaultPrinter = strPrinterName(i) Then 089 '同じプリンター名が見つかった 090 i = CON_FOUND 091 Exit For 092 End If 093 Next i 094 If i <> CON_FOUND Then 095 'エラー：This printer name does not exist. 096 SetDefaultPrinter = False 097 sErrMsg = "エラー：SetDefaultPrinter" & vbCrLf & _ 098 "このプリンター名は存在しない。" & vbCrLf & _ 099 "(" & sDefaultPrinter & ")" 100 Exit Function 101 End If 102 103 '終了コードのセット 104 lErrCode(0) = 0 105 lErrCount = UBound(lErrCode) 106 strCmd = "rundll32.exe printui.dll,PrintUIEntry /y /n """ _ 107 & sDefaultPrinter & """" 108 109 'コマンドラインの実行 110 bRet = RunCommandLineEX(strCmd, strWorkFolder, _ 111 lErrCount, lErrCode, _ 112 strOutFile, strErr, lRetCode) 113 114 sErrMsg = strErr 115 SetDefaultPrinter = bRet 116 117 ' '実行結果の表示 118 ' Debug.Print "bRet=" & bRet 119 ' Debug.Print "lRetCode=" & lRetCode 120 ' strOutFile1 = Split(strOutFile(0), vbCrLf) 121 ' strOutFile2 = Split(strOutFile(1), vbCrLf) 122 ' Debug.Print "strErr=" & strErr 123 ' For i = 0 To UBound(strOutFile1) 124 ' Debug.Print "msg1 i(" & i & ")="; strOutFile1(i) 125 ' Next i 126 ' For i = 0 To UBound(strOutFile2) 127 ' Debug.Print "msg2 i(" & i & ")="; strOutFile2(i) 128 ' Next i 129 130 End Function

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

001 Option Explicit 002 003 Declare Function WaitForSingleObject Lib "kernel32" _ 004 (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long 005 Declare Function CloseHandle Lib "kernel32" _ 006 (ByVal hObject As Long) As Long 007 Declare Function GetExitCodeProcess Lib "kernel32" _ 008 (ByVal hProcess As Long, lpExitCode As Long) As Long 009 Declare Function OpenProcess Lib "kernel32" _ 010 (ByVal dwDesiredAccess As Long, _ 011 ByVal bInheritHandle As Long, _ 012 ByVal dwProcessID As Long) As Long 013 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 014 015 Const SYNCHRONIZE = 1048576 016 Const PROCESS_QUERY_INFORMATION = &H400 017 018 ' Teme File No 019 Private gFileCnt As Long 020 ' Debug Mode [ True=On | False=Off ] 021 Private gDebugMode As Boolean 022 Private Const CON_FOLDER_KUGIRI = "¥" 023 Private Const CON_READ = False 024 025 026 '************************************************** 027 ' 028 ' Run command line & Get messeges 029 ' 030 ' 機能 : コマンドラインを実行する。 031 ' 実行プロセスを監視して終了を待つ。 032 ' 終了メッセージ(標準出力,標準エラー出力)を取得する。 033 ' Create : 2016/07/29 034 ' Update : 2016/08/01 035 ' Vertion : 1.0.1 036 ' 037 ' 第１引数：strInCommand As String (In) 038 ' コマンドライン 039 ' 第２引数：strInWorkFolder As String (In) 040 ' 一時的な作業フォルダ 041 ' 第３引数：lInErrCount As Long (In) 042 ' 終了コードの数。　-1:無し 043 ' 第４引数：lInErrCode() As Long (In) 044 ' 終了コードの配列 045 ' 第５引数：strOutFile() As String (Out) 046 ' strOutFile(0)：標準出力の内容 047 ' strOutFile(1)：標準エラー出力の内容 048 ' 第６引数：strOutErrMsg As String (Out) 049 ' プログラム内のエラーメッセージ。エラー無しは ""。 050 ' 第７引数：lOutRetCode As Long (Out) 051 ' コマンドラインの終了コード 052 ' 053 ' 戻り値 : True:正常終了 False:エラー発生 054 ' 055 ' 備考 : 引数5,6,7の内容でエラー判定を行う。 056 ' URL : https://pdf-file.nnn2.com/?p=908 057 ' その他 : 著作権等は主張しません。 058 ' 上記URLにコメントを頂けると嬉しいです。 059 ' 060 '************************************************** 061 062 Public Function RunCommandLineEX( _ 063 ByVal strInCommand As String, _ 064 ByVal strInWorkFolder As String, _ 065 ByVal lInErrCount As Long, _ 066 ByRef lInErrCode() As Long, _ 067 ByRef strOutFile() As String, _ 068 ByRef strOutErrMsg As String, _ 069 ByRef lOutRetCode As Long) As Boolean 070 On Error GoTo Err_RunCommandLineEX: 071 072 Dim strCmd As String 073 Dim strFilePath As String 074 Dim strTempFilePath(1) As String 075 Dim i As Long 076 077 '初期化 078 RunCommandLineEX = True 079 strOutErrMsg = "" 080 For i = 0 To UBound(strOutFile) 081 strOutFile(i) = "" 082 Next i 083 If Trim$(strInWorkFolder) = "" Then 084 strInWorkFolder = _ 085 Application.ActiveWorkbook.Path & CON_FOLDER_KUGIRI 086 End If 087 088 '▼コマンドラインの編集 089 '一時ファイル 090 gFileCnt = gFileCnt + 1 091 strFilePath = strInWorkFolder & _ 092 Format(Now(), "yyyymmdd-hhmmss-") & gFileCnt 093 '標準出力用 094 strTempFilePath(0) = strFilePath & ".txt" 095 '標準エラー出力用 096 strTempFilePath(1) = strFilePath & "-err.txt" 097 098 '注意：ファイルパスの前後にダブルクォーテーション 099 strCmd = "cmd /c " & strInCommand & _ 100 " > """ & strTempFilePath(0) & _ 101 """ 2> """ & strTempFilePath(1) & """" 102 103 '▼コマンドラインの実行 104 Dim hProcess As Long 105 Dim lpdwExitCode As Long 106 Dim dwProcessID As Long 107 Dim lRet As Long 108 Dim lCnt As Long 109 Const CON_SLEEP = 20 110 Const CON_LOOP_CNT = 250 111 lCnt = 0 112 dwProcessID = Shell(strCmd, vbHide) 113 hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, _ 114 True, dwProcessID) 115 Do 116 Sleep CON_SLEEP 117 DoEvents 118 lRet = GetExitCodeProcess(hProcess, lpdwExitCode) 119 If lInErrCount >= 0 Then 120 For i = 0 To UBound(lInErrCode) 121 If lInErrCode(i) = lpdwExitCode Then Exit Do 122 Next i 123 End If 124 lCnt = lCnt + 1 125 If lCnt > CON_LOOP_CNT Then 126 strOutErrMsg = "[RunCommandLine]Shell Error : " & _ 127 "Time Orver " & CON_SLEEP * CON_LOOP_CNT & "ms" 128 RunCommandLineEX = False 129 Exit Do 130 End If 131 If gDebugMode Then _ 132 Debug.Print "lCnt=" & lCnt & " " & lpdwExitCode 133 Loop While lpdwExitCode <> 0 134 lOutRetCode = lpdwExitCode 135 If gDebugMode Then _ 136 Debug.Print "lCnt=" & lCnt & " " & lpdwExitCode 137 138 If CON_READ Then 139 140 '▼コマンドラインの標準出力と標準エラー出力を取得 141 '▽① 出力テキストを読み込む。 142 ' UTF-8なのでADODB.Streamを使って変換して読み込む。 143 Dim strBuff As String 144 Dim objStream As Object 145 Set objStream = CreateObject("ADODB.Stream") 146 For i = 0 To UBound(strTempFilePath) 147 'UTF-8のファイルを読み込む 148 With objStream 149 .Charset = "UTF-8" 150 .Type = 2 '(1:バイナリ 2:テキスト) 151 .Open 152 .LoadFromFile strTempFilePath(i) 153 strOutFile(i) = .ReadText 154 .Close 155 End With 156 Next i 157 Set objStream = Nothing 158 '△ 159 160 Else 161 162 '▽② 標準出力のテキストを読み込む。 163 Dim strInput As String 164 Dim lFileNo As Long 165 For i = 0 To UBound(strTempFilePath) 166 lCnt = 0 167 lFileNo = FreeFile 168 Open strTempFilePath(i) For Input As #lFileNo 169 Do Until EOF(lFileNo) 170 Line Input #lFileNo, strInput 171 If lCnt = 0 Then 172 strOutFile(i) = Trim(strInput) 173 Else 174 strOutFile(i) = strOutFile(i) & _ 175 vbCrLf & Trim(strInput) 176 End If 177 lCnt = lCnt + 1 178 Loop 179 Close #lFileNo 180 Next i 181 '△ 182 183 End If 184 185 '▼一時ファイルの削除 186 For i = 0 To UBound(strTempFilePath) 187 Kill strTempFilePath(i) 188 Next i 189 190 Exit Function 191 Err_RunCommandLineEX: 192 strOutErrMsg = "(RunCommandLine) Runtime Error :" & _ 193 Err.Number & vbCrLf & Err.Description & vbCrLf & _ 194 vbCrLf & "Command=" & strCmd 195 RunCommandLineEX = False 196 End Function

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

001 Option Explicit 002 003 '====================================================================== 004 ' 005 ' 名称 ：OSのプリンターを全て取得 006 ' 機能 ：OSのプリンターを取得して、strPrinterName()配列に返す。 007 ' strPrinterName(0)には「通常使うプリンター」がセットされる。 008 ' strPrinterName(1)以上にそれ以外はプリンターがセットされる。 009 ' バージョン：1.0 010 ' 作成日 ：2017/08/19 初版 011 ' URL ：https://pdf-file.nnn2.com/?p=1012 012 ' 013 '====================================================================== 014 015 Public Function nnn2GetAllPrinters( _ 016 ByRef strPrinterName() As String) As Boolean 017 018 nnn2GetAllPrinters = True 019 On Error GoTo Err_nnn2GetAllPrinters: 020 021 ReDim strPrinterName(10) As String 022 Dim varWMIService As Variant 023 Dim varPS As Variant 024 Dim objPrinter As Object 025 Dim i As Long 026 i = 0 027 strPrinterName(0) = "" 028 strPrinterName(1) = "" 029 Set varWMIService = CreateObject("winmgmts:{impersonationLevel=impersonate}!¥¥.¥root¥cimv2") 030 Set varPS = varWMIService.ExecQuery("Select * from Win32_Printer") 031 For Each objPrinter In varPS 032 If objPrinter.Default Then 033 '通常使うプリンターを取得 034 strPrinterName(0) = objPrinter.Caption 035 Else 036 i = i + 1 037 strPrinterName(i) = objPrinter.Caption 038 End If 039 Next 040 ReDim Preserve strPrinterName(i) As String 041 Exit Function 042 043 Err_nnn2GetAllPrinters: 044 MsgBox "nnn2GetAllPrinters " & vbCrLf & _ 045 Err.Description, vbCritical, "Runtime Error" 046 nnn2GetAllPrinters = False 047 End Function

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

備考

1. 「rundll32.exe printui.dll,PrintUIEntry /y /n "プリンター名"」でプリンター名を間違えると以下のエラー画面が表示されてしまいます。これが表示されるとプログラムの処理が中断してしまいます。そこで表示されないように事前にチェックして存在しないプリンター名はエラーにします。
   

   

2. 「rundll32.exe printui.dll,PrintUIEntry /?」で他のパラメータのヘルプが表示されます。

参照

• 関数：OSのプリンターを全て取得
• 関数：コマンドラインを実行
• Rundll32 の printui.dll,PrintUIEntry
  コマンドのパラメータや使い方を説明したMiscrosoftサイトの技術ページ。

＜　サンプル/関数　＞