2019年10月24日 / 最終更新日時 : 2022年7月1日 officeの杜 msoffice

VBAで特定のフォルダ内のPDFをキーワードで引っ掛けて連続印刷

事務作業の現場では、ファイルサーバ上に於いてディレクトリ構造に合わせてファイルを配置したり作成したりといった、本業に付随する雑務が結構な量あります。しかもそれにかなりの時間を費やしていたりするケースもあります。

配置だけでなく配置後の加工や編集作業などの業務も非常に多く、さらに加工後はこちらに配置といったように移動が行われたりもするわけです。これらの業務は時間は掛かるもののそれ自体に大きな価値があるわけではありません。そこでこれらの業務を自動化となると出てくるのが「VBA」。

今回はそういったジャンルの１つである「特定フォルダ内のPDFをキーワードで検索しファイルを印刷する」を、フォルダのドラッグアンドドロップで実現するものを作ってみました。

1 今回使用するファイル
2 事前準備
- 2.1 参照設定
- 2.2 ListViewコントロールの追加
3 使い方
- 3.1 セッティング
- 3.2 実際にファイルを取り出してみる
4 ソースコード
- 4.1 settingフォーム
- 4.2 listviewフォーム
  - 4.2.1 通常の連続印刷の場合
  - 4.2.2 両面印刷をしたい場合
5 関連リンク

今回使用するファイル

PDF連続印刷プログラム - Excelワークブック

※事前にプログラムの設定を行う必要があります。

※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フォーム

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

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

Set tempShell = Nothing

'iniファイルのプリンタ名をコンボボックスに入れる

Me.ComboBox1.Value = IniRead("USER", "PRINTER", "")

End Sub

FileDialogにて保存先フォルダの指定を行わせています。初期値はデスクトップのパスを取得して割り当てています。
フォームを開いた時にInitializeが実行され、iniファイルからの設定値がロードされます。
また、インストール済みのプリンタリストを構築し、コンボボックスに追加も行っています。
設定を保存ボタンにて、入力済みの設定値をiniファイルへと保存を行います。

listviewフォーム

通常の連続印刷の場合

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

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

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個オプションとして、両面印刷のチェックボックスを追加し、設定を保存するコードを追加しています。

'フォームロード時
Me.CheckBox2.Value = IniRead("USER", "DUPLEX", "FALSE")

'保存ボタンクリック時
IniWrite "USER", "DUPLEX", Me.CheckBox2.Value

'フォームロード時

Me.CheckBox2.Value = IniRead("USER", "DUPLEX", "FALSE")

'保存ボタンクリック時

IniWrite "USER", "DUPLEX", Me.CheckBox2.Value

listviewフォーム

連続印刷オプションにチェックが入ってる場合にオンとなるようにコードを組んであります。もちろん、両面印刷オプションもオンである必要性があります。

'ドラッグ＆ドロップされた時の処理
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

'ドラッグ＆ドロップされた時の処理

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

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

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 sub

両面印刷コード

pdfremote関数として呼び出される、両面印刷を実行する為のコードです。直接ドライバに指示が出せないので、印刷ダイアログをVBAで操作して印刷を実行させるテクニックです。

'プログラムにウェイトをさせるためのコマンド
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

'プログラムにウェイトをさせるためのコマンド

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

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のコマンドラインスイッチでは今回は印刷を実行させていません。

VBAで特定のフォルダ内のPDFをキーワードで引っ掛けて連続印刷

今回使用するファイル

事前準備

参照設定

ListViewコントロールの追加

使い方

セッティング

実際にファイルを取り出してみる

ソースコード

settingフォーム

listviewフォーム

通常の連続印刷の場合

両面印刷をしたい場合

settingフォーム

listviewフォーム

両面印刷コード

関連リンク

コメントを残すコメントをキャンセル

Accessで条件付きグループ分けを作ってみた

Google Workspaceの共有関係に関するまとめ

今回使用するファイル

事前準備

参照設定

ListViewコントロールの追加

使い方

セッティング

実際にファイルを取り出してみる

ソースコード

settingフォーム

listviewフォーム

通常の連続印刷の場合

両面印刷をしたい場合

settingフォーム

listviewフォーム

両面印刷コード

関連リンク

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル