VBAで特定のフォルダ内のPDFをキーワードで引っ掛けて連続印刷
事務作業の現場では、ファイルサーバ上に於いてディレクトリ構造に合わせてファイルを配置したり作成したりといった、本業に付随する雑務が結構な量あります。しかもそれにかなりの時間を費やしていたりするケースもあります。
配置だけでなく配置後の加工や編集作業などの業務も非常に多く、さらに加工後はこちらに配置といったように移動が行われたりもするわけです。これらの業務は時間は掛かるもののそれ自体に大きな価値があるわけではありません。そこでこれらの業務を自動化となると出てくるのが「VBA」。
今回はそういったジャンルの１つである「特定フォルダ内のPDFをキーワードで検索しファイルを印刷する」を、フォルダのドラッグアンドドロップで実現するものを作ってみました。
リンク
目次
今回使用するファイル
※事前にプログラムの設定を行う必要があります。
※PDFの規定のアプリは、Adobe Readerである必要があります。
事前準備
参照設定
今回のプログラムは、いくつかの参照設定を追加しています。手動で追加する項目は
- Microsoft Scripting Runtime
- Windows Script Host Object Model (shellによるコマンドライン実行で使用します)
の２つ。及び、UserFormで「ListView」を追加している関係で、
- Microsoft Forms 2.0 Object Library
- Microsoft Windows Common Controls 6.0 (SP6)
が追加されています。この２つについては参照設定ではなく、UserForm上でのコントロールの追加にて自動的に追加されるようになっています。
図：参照設定の追加
ListViewコントロールの追加
Visual Basicの画面にて新しくユーザフォームを追加したい場合には、「挿入」⇒「ユーザフォーム」を選択する事で、フォームを追加する事が可能です。また、標準で用意されているコントロールの他に、Visual Basic 6.0等で用意されてるOCXファイルを指定出来、今回は「ListViewコントロール」を追加してあります。追加手順は以下の通り。
- UserFormを開く
- メニューより「ツール」⇒「その他のコントロール」を開く
- コントロールの追加ダイアログにて、Microsoft ListView Control, version X.Xを探して、チェックを入れてOKする
- コントロールのツールボックスにListViewコントロールが追加されるようになります。
- 実際に貼り付けて、コントロールのプロパティに於いて、OLEDragMode = ccOLEDragAutomatic、OLEDropMode = ccOLEDropManualに設定を変更してあります。
図：ListViewコントロールは追加しないと表示されない
図：開発時はOLEDragModeなども設定しておく必要があります。
使い方
今回使用するファイルを開くと「ファイル抽出」というリボンが追加されています。事前にセッティングが必要となります。
セッティング
「アプリの設定」をクリックすると、プログラムセッティング用のダイアログが表示されます。以下の項目をセッティングしておきましょう。
- 保存先 - キーワードに合致したファイルを指定のフォルダにコピーします。【必須】
- 抽出ファイル名 - ファイル名を指定します。実際には前後をアスタリスクで括ったワイルドカードで検索しています【必須】
- プリンタ選択 - 連続印刷をする場合にはここでプリンタを選んでおきます。リストは自動でインストール済みプリンタが出ます
- 連続印刷実行 - オプション項目で、2.でヒットしたファイル（PDF）を連続で印刷する場合にはチェックを入れます。
設定はBookと同じファイル名で同じディレクトリにiniファイルとして保存されます。途中でファイル名を変えてしまうと前の設定はiniファイルの方もファイル名を変えてやる必要があります。
図：設定用のダイアログは必ずセットアップが必要です
実際にファイルを取り出してみる
「ファイルの抽出と印刷」を実行するとListViewのついたダイアログが表示されます。このListViewに対して以下の処理を行うと、ファイルのコピーと連続印刷が実行されます。
- 検索したいフォルダを掴んで、ListViewコントロールにドラッグ・アンド・ドロップする。
- 処理をするか否かのメッセージで「はい」を選ぶと処理を実行します。
- 指定のキーワードをファイル名に含むファイルをリストへと追加しつつ、オプションで連続印刷を実行にチェックが入っている場合、ここでAdobe Readerを利用して印刷を行っています。
- また、同じファイルを指定のフォルダにコピーを行います。
図：ヒットするファイルがあるとリストに登録されます。
ソースコード
settingフォーム
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
Private Sub CommandButton1_Click() '初期フォルダはデスクトップにする Dim deskpath As String deskpath = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "\" 'フォルダを選択するダイアログ表示 With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = deskpath .AllowMultiSelect = False .Title = "保存先フォルダの選択" If .Show = True Then 'テキストボックスにパスを代入 Me.TextBox1.Value = .SelectedItems(1) End If End With End Sub Private Sub CommandButton2_Click() 'デフォルトの保存先 IniWrite "USER", "SAVEPATH", Me.TextBox1.Value 'デフォルトの抽出キーワード IniWrite "USER", "KEYWORD", Me.TextBox2.Value 'プリントオプション IniWrite "USER", "PRINTOPT", Me.CheckBox1.Value 'プリンタ名 IniWrite "USER", "PRINTER", Me.ComboBox1.Value 'フォームを閉じる Unload UserForm2 End Sub '初期化時にiniファイルから設定を読み込む Private Sub UserForm_Initialize() '初期化 Me.CheckBox1.Value = False 'デフォルトの保存先 Me.TextBox1.Value = IniRead("USER", "SAVEPATH", "") 'デフォルトの抽出キーワード Me.TextBox2.Value = IniRead("USER", "KEYWORD", "") '印刷オプション Me.CheckBox1.Value = IniRead("USER", "PRINTOPT", "FALSE") 'プリンタ名リストをコンボボックスに反映 '変数の定義' Dim tempShell As Object Dim prinman As Object Set tempShell = CreateObject("Shell.Application") intRow = 1 For Each prinman In tempShell.Namespace(4).Items With ComboBox1 .AddItem prinman.Name End With Next Set tempShell = Nothing 'iniファイルのプリンタ名をコンボボックスに入れる Me.ComboBox1.Value = IniRead("USER", "PRINTER", "") End Sub |
- FileDialogにて保存先フォルダの指定を行わせています。初期値はデスクトップのパスを取得して割り当てています。
- フォームを開いた時にInitializeが実行され、iniファイルからの設定値がロードされます。
- また、インストール済みのプリンタリストを構築し、コンボボックスに追加も行っています。
- 設定を保存ボタンにて、入力済みの設定値をiniファイルへと保存を行います。
listviewフォーム
通常の連続印刷の場合
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 |
Public Printername As String Public printoption As Boolean Public filefilter As String Public exportpath As String Public counter As Long 'ドラッグ＆ドロップされた時の処理 Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single) 'Scripting Runtimeの初期化 Dim FSO As FileSystemObject Set FSO = New FileSystemObject '変数の宣言 Dim result As Variant counter = 0 '処理を実行するか確認 result = MsgBox("フォルダ内の特定ファイル名のPDFを処理しちゃいますよ？？", vbYesNo + vbDefaultButton2 + vbExclamation) If result = vbYes Then 'インポート処理を続行する Else 'メッセージを表示 MsgBox "処理をキャンセルしました。" '終了処理 Exit Sub End If 'フィルタするファイル名の値をiniファイルから取得する Printername = IniRead("USER", "PRINTER", "") exportpath = IniRead("USER", "SAVEPATH", "") filefilter = IniRead("USER", "KEYWORD", "") printoption = IniRead("USER", "PRINTOPT", "") If exportpath = "" Or IsNull(exportpath) Then MsgBox "ファイルの保存先が指定されていませんよ" Exit Sub End If If filefilter = "" Or IsNull(filefilter) Then MsgBox "ファイル名抽出用のキーワードが設定されていませんよ。" Exit Sub End If If FSO.FolderExists(exportpath) Then Else MsgBox "出力先フォルダが存在しませんよ" Exit Sub End If 'ドラッグされたフォルダの親パスを確定する Dim targetfolder As String Dim parentfolderpath As String parentfolderpath = FSO.GetParentFolderName(Data.Files(1)) targetfolder = parentfolderpath & "\" & FSO.GetFileName(Data.Files(1)) & "\" 'FileSearchを使って処理 Call FileSearch(targetfolder) '終了処理 MsgBox "処理が完了しました。" End Sub 'ファイルを探索して Public Sub FileSearch(targetfolder As String) 'Scripting Runtimeの初期化 Dim FSO As FileSystemObject Set FSO = New FileSystemObject Dim Folder As Variant, File As Variant Dim filenameman As String 'Acrobat Readerで印刷するコマンド用変数 Dim shell As IWshRuntimeLibrary.WshShell Set shell = New IWshRuntimeLibrary.WshShell Dim shellcom As String 'ファイルパス Dim srcFile As String, destFile As String 'サブフォルダ探索 For Each Folder In FSO.GetFolder(targetfolder).SubFolders '再帰的に関数を呼び出し Call FileSearch(Folder.path) Next Folder 'フォルダ内のファイルを探索 For Each File In FSO.GetFolder(targetfolder).Files If InStr(File.Type, "Adobe Acrobat Document") > 0 Then 'ファイル名だけ取得する filenameman = File.Name 'ファイル抽出キーワードを含むかどうかを判定 If filenameman Like "*" & filefilter & "*" Then 'コピー元とコピー先のパスを取得 srcFile = targetfolder & "\" & filenameman destFile = exportpath & "\" & counter & "_" & filenameman 'ファイルを指定の場所にコピーする FSO.CopyFile srcFile, destFile '印刷オプションがTrueなら連続印刷も行う If printoption = True Then 'ファイルを印刷する 'Shellコマンドを設定 shellcom = "AcroRd32.exe /t " & exportpath & "\" & counter & "_" & filenameman & " " & Printername 'Shellコマンドを実行 shell.Run (shellcom) End If 'リストビューに情報を追加 With ListView1.ListItems.Add .Text = filenameman .SubItems(1) = "処理完了" End With 'カウンターを加算 counter = counter + 1 End If End If Next File Exit Sub End Sub 'ユーザフォームを初期化する Private Sub UserForm_Initialize() '初期化の実行 With ListView1 .View = lvwReport .LabelEdit = lvwManual .HideSelection = False .AllowColumnReorder = True .FullRowSelect = True .Gridlines = True .ColumnHeaders.Add , "Filename", "ファイル名", 200 .ColumnHeaders.Add , "Result", "処理結果", 100 End With End Sub |
- 設定値関係はグローバル変数で格納してあります。
- ListViewに於いてOLEDragDropイベント内に今回のメインとなるコードを記述します。
- Dragされたフォルダのパスをtargetfolderに格納し、次のサブルーチンへと渡しています。
- サブフォルダがあった場合には、サブフォルダ内を探索するように再帰的にFileSearchを呼び出す仕組みになっています。
- PDFファイルであるか？また、ファイル名に指定のキーワードが入っているか？をLikeで調査し、含まれている場合にはファイルの処理を続行する。
- コピー先ではファイル名の頭に連続した数字を付与するようにしています。
- 印刷オプションが有効な場合には、Adobe Readerを立ち上げ、印刷を実行するShellコマンドをCallするようにしてあります。
- ListViewコントロールには、File.typeがAdobe Acrobat Documentで、指定のキーワードを含むものが今回の処理対象となります。File.typeの部分をExcelなどにすれば、Excelのファイルがヒット対象になります。
両面印刷をしたい場合
VBAではExcelなどの場合はそこそこ詳細な印刷の指示を渡す事が可能ですが、それでもプリンタドライバに対する非常に詳細な設定を、直接操作する事が出来ません（それ専用のDLLがあれば可能ですが、非常にお高い）。そのため、結構よく利用する「両面印刷」ですが、VBAから正攻法で実行する手段がありません。
そこで利用するのがVBAで他のアプリケーションを操作するでも紹介してる、特定のウィンドウに対してキー操作を送り込む手法で両面印刷に対応する事が可能です。今回はAdobe Readerを対象としてるため、他のプリンタドライバ等の場合には、キーが異なると思いますので、適宜読み替えてください。
以下に前のコードに追加した部分を追記します。
settingフォーム
フォームに1個オプションとして、両面印刷のチェックボックスを追加し、設定を保存するコードを追加しています。
|
1 2 3 4 5 |
'フォームロード時 Me.CheckBox2.Value = IniRead("USER", "DUPLEX", "FALSE") '保存ボタンクリック時 IniWrite "USER", "DUPLEX", Me.CheckBox2.Value |
listviewフォーム
連続印刷オプションにチェックが入ってる場合にオンとなるようにコードを組んであります。もちろん、両面印刷オプションもオンである必要性があります。
|
1 2 3 4 5 6 7 8 |
'ドラッグ＆ドロップされた時の処理 Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single) ・・・・・・前略・・・・・・ duplexopt = IniRead("USER", "DUPLEX", "") ・・・・・・後略・・・・・・ end function |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
Public Sub FileSearch(targetfolder As String) ・・・・・・前略・・・・・・ '印刷オプションがTrueなら連続印刷も行う If printoption = True Then '両面印刷かどうか？ If duplexopt = False Then 'ファイルを印刷する 'Shellコマンドを設定 strShellCommand = "AcroRd32.exe /t " & exportpath & "\" & counter & "_" & filenameman & " " & Printername 'Shellコマンドを実行 wshShellObj.Run (strShellCommand) Else '両面印刷の実行 ret = pdfremote(exportpath & "\" & counter & "_" & filenameman) '返り値の検証 If ret = False Then MsgBox "エラーが発生し印刷が停止しました。" Exit Sub End If End If End If ・・・・・・後略・・・・・・ end sub |
両面印刷コード
pdfremote関数として呼び出される、両面印刷を実行する為のコードです。直接ドライバに指示が出せないので、印刷ダイアログをVBAで操作して印刷を実行させるテクニックです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
'プログラムにウェイトをさせるためのコマンド Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long) 'プロセスIDからプロセスオブジェクトハンドルを取得する Public Declare PtrSafe Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long 'ウィンドウハンドルをアクティブにする Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long '定数定義 Public Const SYNCHRONIZE = &H100000 'PDFを開いてプリンタセットアップして閉じる Public Function pdfremote(ByVal srcFile As String) As Boolean 'エラーが発生したら捕捉する On Error GoTo error_pdfremote 'Acrobat Readerで印刷するコマンド用変数 Dim shellcom As String Dim adobe As String Dim procid As Long Dim hwnd As Long Dim timekun As Long adobe = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" shellcom = adobe & " " & srcFile timekun = 1500 Dim objShell As Object, objExec As Object Set objShell = CreateObject("WScript.Shell") Set objExec = objShell.Exec(shellcom) '起動したプログラムのPIDを取得する procid = objExec.ProcessId 'sleep Sleep timekun 'PIDからhwndを取得 hwnd = OpenProcess(SYNCHRONIZE, True, procid) 'hwndをアクティブにする SetForegroundWindow hwnd '閉じる SendKeys "^p" Sleep timekun SendKeys "%B" Sleep timekun SendKeys "{ENTER}" Sleep timekun Sleep timekun SendKeys "%{F4}" '値を返す pdfremote = True Exit Function error_pdfremote: 'エラーとして呼び出し元へ返す pdfremote = False Exit Function End Function |
- 連続印刷実行オプションが有効で、尚且つ、両面印刷実行のオプションが有効な時だけ実行されます。
- shellのexecコマンドの場合、Runコマンドと違い、実行した結果のプロセスIDなどが取得出来ます。
- Adobe Readerのexeまではフルパスで。パスが通っていれば、AcroRd32.exeだけでも実行可能。
- ウェイトはおよそ15秒ほど。sleep関数にて実行しています。
- shellの返り値のオブジェクトに対して、ProcessIdにてプロセスIDを取得可能です。
- OpenProcess関数にてProcessIdからウィンドウハンドルを取得しています。取得しないどれか別の開いてるウィンドウに対して処理が実行されてしまいます。
- SetForegroundWindow関数にて、指定のウィンドウハンドルのウィンドウをアクティブにしています。
- Sendkeysにてキーコードを送りつけます。印刷実行⇒ダイアログ表示されたらAlt+Bにて両面印刷にチェックを入れさせる。
- 最後はEnterキーにて両面印刷を実行しています、その後Alt + F4キーの送信でプログラムを終了させています。
- 印刷実行まで完了したら、呼び出し元に返り値を返します。
- 注意事項として、印刷指示実行中はPCの操作は禁物。おかしな挙動になったり、プログラムが終了する可能性もあります。
- Adobe Readerのコマンドラインスイッチでは今回は印刷を実行させていません。
