概要
Acrobat アプリケーションのアクション処理（バッチ処理）をプログラムで実行します。
実行から終了までをプログラムで監視し、結果はログテキストでファイル出力します。
- 通常ではAcrobat の全バージョン( 5 ～ 11 )はAcrobat OLE を使ってもアクションやバッチ処理を起動する事すら出来ないです。
そこで、当サンプルは Acrobat OLE と自動化ソフトの AutoItX3 OLE を連携させて全てをプログラミング操作で行います。
- 自動化ソフト AutoIt は商用利用も含めてフリーでの使用が可能になっています。
VBA のSendKeys ステートメントより安定、高機能な仕様になっています。
動作環境
当サイトが出した結果です。
必ず自分の環境で動作確認をしてください。
| Acrobat | 動作 | 備考 |
|---|---|---|
| 4 | X | Acrobat 4.0 ※Windows 98SE + Excel 2000 ※バッチ処理自体が未サポート |
| 5 | X | Acrobat 5.0.5 + Excel 2003 ※当サンプルでは対応しません。予定も無し |
| 6 | OK | Acrobat 6.0.6 Pro + Excel 2003 |
| 7 | OK | Acrobat 7.1.4 Pro + Excel 2003 |
| 8 | OK | Acrobat 8.3.1 Pro + Excel 2003 |
| 9 | OK | Acrobat 9.5.5 Extended + Excel 2003 |
| 10 | OK | Acrobat X (10.1.9) Extended + Excel 2003 |
| 11 | X | Acrobat XI (11.0.06) Extended+ Excel 2003 ※当サンプルでは対応出来ません。 注意事項を参照 |
- OK ： 正常終了する。
- NO ： 動作しない。 又は実行時にエラーになる。
- X ： 未対応。詳細は下の 注意 を参照ください。
- - ： 未確認
事前準備と環境作成
1. 以下の環境が有るパソコンを準備
- Windows 7 以上
※Windows XPでもOK
- 上記の動作環境に書いてある Acrobat アプリケーション
- Excel 2003 以上
Excel 2000 でも動くかもしれませんが、動作未確認。
Excel が64bit版の場合は、VBAコードの一部修正が必要。
2. Autoit のインストール
自動化ソフトのAutoit インストールが必要です。
Autoit のフルインストールが可能な場合は、以下を参照。
必要なDLL のみのインストールなら
3. Acrobat の環境設定を変更
Acrobat の環境設定でアクションウイザードを開いて
（Acrobat 9 以下はバッチ処理）
- 「アクション実行の確認ダイアログを表示」 をオン
- 「警告とエラーをログ・ファイルに保存」 をオン
- 「場所の選択」 で保存フォルダを指定
を事前に設定しておきます。 （必須）
4. Acrobat にアクション（バッチ処理）を事前登録
起動するアクション（バッチシーケンス）を事前に登録しておく必要が有ります。
アクション名（バッチシーケンス名）は日本語も使えますが、当サンプルのプログラム仕様上の問題で半角英数字でお願いします。
- Acrobat 10 で「PrEdit」と登録した場合
参照：（Acrobat X）アクションの使用および作成方法
- Acrobat 9 で「PrEdit」と登録した場合
5. サンプルのダウンロード
- AutoRun_Acrobat_Action_100.zip
( 70,246 バイト)
ダウンロードしたら、解凍して AutoRun_Acrobat_Action_100.xls ファイルを取り出します。
サンプルの実行
AutoRun_Acrobat_Action_100.xls ファイルを実行します。
1. 最初に以下のシートが表示されます。
読んでください。
2. MAIN シートを開きます。
- 上記で登録したアクション名（バッチのシーケンス名）
- Acrobat が処理する時の予想タイムアウト時間（秒）
をシート上に入力します。
最後に「実行」ボタンをマウスでクリックします
3. 良ければ、「OK」ボタンをマウスでクリックします。
この後で、プログラム内部で各種の事前チェックが行われます。
問題が有れば、以下の様なエラーが表示されます。
4. Acrobat のアクション処理（バッチ処理）が終了するまで待ちます。
終了すると以下の様な終了ダイアログ画面が表示されます。
同時にAcrobat の環境設定の「場所の選択」 で指定したフォルダにログファイルを出力します。
備考
- Acrobat XI (v11) バージョンに関してはユーザーインターフェースが全く変わってしまうので、別サンプルで対応したいと考えています。
但し、AutoItX3 の全く別の機能を使う必要があると思われるので、もう少し慣れてから考えたいです。
- サンプルはExcel VBA で提供してます。
VBAは歴史の古いBASIC言語なので他のプログラミングに移行しやすいと考えている。
- VBAにはSendKeysステートメントが有ります。
しかし、キーボード操作を簡単にシミュレーションは出来るが、安定性に欠けます。
アプリケーションの操作には向いてない。
- ソース内部に大量のコメントが開発時のメモとして有ります。
使用時は注意し削除してください。
- 不具合は出来るだけ対応したいと思いますが、時間日数等の保証は全く出来ません。
- 活用できた場合は、どの様な使い方をしたかのコメントを頂けると助かります。
またカスタマイズした箇所等の情報も頂けると嬉しいです。
今後に活かしたいと思ってますのでよろしくお願い致します。
- 自動化ソフト AutoItX3 に関する技術的な質問に返答できる知識を当サイト管理者はまだ持っていません。
その前提でコメント投稿を開放します。
注意事項
- アクション名、又はバッチ名は半角の英数字で登録してください。
それ以外の文字種を使うとAutoItX3 操作が失敗するかもしれません。
- Acrobat 5 , Acrobat XI は当サンプルでは対応しません。
理由 Acrobat 5 ：古いソフトで有り、サポート・メンテナンスに無理が有る。
理由 Acrobat XI ：画面UIが変更になって、当サンプルでは全く対応不可。
- AcrobatInfo.exe がバックグランドで勝手に動いて当サンプルの動作に支障を出るかもしれません。
当サンプルを元に作ったアクション処理（バッチ処理）プログラムを使う時は、このAcrobatInfo.exe を一時停止するような措置を考えて下さい。
※当サイトでは自己責任で AcrobatInfo.exe をリネームして、一時的に停止させました。
- VBAのSendKeysステートメントよりは自動化ソフト AutoItX3 OLE の方が、安定して使えます。
但し、自動化ソフト AutoItX3 は基本が画面操作になるので非常にデリケートなプログラミングが必要になります。
動作環境の影響も少なからず受け、操作失敗につながることもありますので、問題が出たと思われる時は、まずは Windowsの再起動をお勧めします。
- Acrobat X (v10) の以下のアクション実行確認画面に「このアクションには、以後表示しない」が表示されていますが、決してオンにしないで下さい。
動作を正確に監視する上で以下の画面表示は絶対に必要です。
間違ってオンした場合は、一旦アクションを削除して、再度登録し直してください。
動作確認環境
- Acrobat 5.0.5 + Office 2003( + SP3)
+ WindowsXP Pro( + SP3 + WindowsUpdate) - Acrobat 6.0.6 Pro + Office 2003( + SP3)
+ WindowsXP Pro( + SP3 + WindowsUpdate) - Acrobat 7.1.4 Pro + Office 2003( + SP3)
+ WindowsXP Pro( + SP2 + WindowsUpdate) - Acrobat 8.3.1 Pro + Office 2003( + SP3)
+ WindowsXP Pro( + SP3 + WindowsUpdate) - Acrobat 8.3.1 Pro + Office 2007( + SP3)
+ Windows 7 64bit( + SP1 + WindowsUpdate) - Acrobat 9.5.2 Extended + Office 2003( + SP3)
+ WindowsXP Pro( + SP3 + WindowsUpdate) - Acrobat X (10.1.4) Extended + Office 2003( + SP3)
+ WindowsXP Pro( + SP3 + WindowsUpdate) - Acrobat XI (11.0.06) Extended + Office 2003( + SP3)
+ WindowsXP Pro( + SP3 + WindowsUpdate)
サンプルソース：Excel VBA
- F8キーでステップ実行するとAutoItX3ステートメントが失敗する場合が有るので、Debug.Printでトレースを取るようにしてください。
- Acrobatの参照設定 をしています。
- AutoItX3 の参照設定 をしています。
001 Option Explicit
002
003 'Test Mode
004 Public Const CON_TEST = False 'True:Test Mode / False:No Test Mode
005
006 '▼以下は全体で使うグローバル変数&定数▼
007 'バッチ処理の「進捗状況」画面のタイムアウト時間(秒)
008 Dim glTimeOut As Long
009 '動作Acrobatのバージョン番号 6～10
010 '※当サンプルで動作するのは Acrobat 6 , 7 , 8 , 9 , 10 です
011 Public glAcrobatVersion As Long
012 'ログの保存先フォルダ ※最後は\
013 Public gstrLogSavePath As String
014 '処理内部でのプログラミング・エラーのメッセージ
015 Private gstrErrorMsg As String
016 'AutoItX3 オブジェクト
017 Public gobjAutoItX3 As New AutoItX3Lib.AutoItX3
018
019
020
021 '処理中でのAutoItX3.Sleep のデフォルト値
022 '※画面等が切り替わる所はSleepを入れないと失敗する場合が有る
023 Public Const CON_SLEEP = 100
024 '起動するアクション名(バッチシーケンス名)
025 Private gstrRunBatchName As String
026
027 '*********************************************************
028 '
029 ' Test Main sub
030 '
031 '*********************************************************
032
033 Public Sub Main_test()
034
035 'メッセージボックスを表示する
036 If MsgBox("処理を開始しますか？", _
037 vbOKCancel + vbDefaultButton2 + vbQuestion, "確認") _
038 = vbCancel Then
039 Exit Sub
040 End If
041
042 Dim lRet As Long '戻り値
043 Dim bRet As Boolean '戻り値
044 Dim strMenuBatchName As String 'メニュー上の[バッチ処理]名
045
046 '----------------------------------------------------------
047 'Acrobatの環境設定のチェック＆事前確認のチェック
048 If bCheckAcrobatBatch = False Then Exit Sub
049
050 'Acrobatオブジェクトの定義＆作成
051 'Acrobat 4,5,6 の時
052 '※CreateObject実行後にAcrobatがメモリにロードされる
053 ' Dim objAcroApp As Acrobat.CAcroApp
054 ' Set objAcroApp = CreateObject("AcroExch.App")
055 'Acrobat 7,8,9,10,11 の時
056 Dim objAcroApp As New Acrobat.AcroApp
057
058 '----------------------------------------------------------
059 'Acrobatの起動
060 lRet = objAcroApp.Show
061 '開いていた不要なドキュメントを閉じる
062 lRet = objAcroApp.CloseAllDocs
063
064 '----------------------------------------------------------
065 'Acrobatのバッチシーケンス画面を表示
066
067 '[バッチ処理]メニューが有るか(使えるか)チェックする
068 strMenuBatchName = "BatchEdit"
069 lRet = objAcroApp.MenuItemIsEnabled(strMenuBatchName)
070 If lRet = 0 Then
071 '実行可能でない
072 gstrErrorMsg = "[E01] Acrobatのバッチ処理：バッチシーケンス画面が" & _
073 vbCrLf & "表示出来ませんでした" & _
074 vbCrLf & vbCrLf & "処理は開始できませんでした。"
075 MsgBox gstrErrorMsg, _
076 vbOKOnly + vbCritical + vbSystemModal, "プログラム・エラー"
077 GoTo Skip_Main_test:
078 End If
079
080 '実行可能なので、メニューを実行
081 lRet = objAcroApp.MenuItemExecute(strMenuBatchName)
082 '※バッチシーケンス画面が表示されると次の命令へ行く
083
084 '----------------------------------------------------------
085 'Acrobatのバッチ処理をAutoItで監視&操作する
086 Call subRun_Acrobat_Batch(gstrRunBatchName)
087
088 Skip_Main_test:
089 '----------------------------------------------------------
090 'アプリケーションの終了
091 objAcroApp.CloseAllDocs
092 lRet = objAcroApp.Hide
093 lRet = objAcroApp.Exit
094
095 'オブジェクトの強制開放
096 Set objAcroApp = Nothing
097
098
099
100 'ログファイルの出力と 終了メッセージの表示
101 Call subPutMessage
102
103 End Sub
104
105 '*********************************************************
106 '
107 ' Acrobat の環境設定/バッチ処理(アクションウイザード)のチェック
108 '
109 ' Create : 2014/03/22
110 ' Update : 2014/03/22
111 ' Vertion : 1.0.0
112 '
113 ' 備考 :
114 ' URL : http://pdf-file.nnn2.com/?p=786
115 ' その他 : 著作権等は主張しません。
116 ' 上記URLにコメントを頂けると嬉しいです。
117 '
118 '*********************************************************
119
120 Function bCheckAcrobatBatch() As Boolean
121
122 Dim strAcrobatPath As String 'Acrobatのパス
123 Dim strVersion As String 'Acrobatのバージョン
124 Dim strMsg As String '処理後のエラーメッセージ
125 Dim lRet As Long '戻り値
126 Dim strAcrobatClass As String 'AcrobatクラスID
127 Dim strAcrobatTitle As String 'Acrobatタイトル
128
129 gstrErrorMsg = ""
130
131 '------------------------------------------------------
132
133 'Acrobatのバージョンを取得
134 Call Get_Adobe_App_Info_nnn2("Acrobat", _
135 strAcrobatPath, strVersion, strMsg)
136
137 If CON_TEST Then Debug.Print _
138 "AcrobatPath ='" & strAcrobatPath & "'" & vbCrLf & _
139 "Acrobat Version='" & strVersion & "'" & vbCrLf & _
140 "Message ='" & strMsg & "'"
141
142 If strVersion = vbNullString Then
143 gstrErrorMsg = _
144 "[E10] Acrobat がインストールされて無い環境では" _
145 & "動作しません。" & vbCrLf & vbCrLf & _
146 "処理は開始できませんでした。"
147 MsgBox gstrErrorMsg, _
148 vbOKOnly + vbCritical + vbSystemModal, "環境エラー"
149 bCheckAcrobatBatch = False
150 Exit Function
151 End If
152
153 '取得したAcrobatのバージョン
154 glAcrobatVersion = strVersion
155
156 '使用出来るAcrobatのバージョンかチェック
157 If glAcrobatVersion > 10 Or _
158 glAcrobatVersion < 6 Then
159 '定数のエラー
160 gstrErrorMsg = "[E11] 当プログラムは Acrobat " & _
161 glAcrobatVersion & " では動作しません。" & _
162 vbCrLf & "動作するのはAcrobat 6, 7, 8, 9, X(10) のみです。" _
163 & vbCrLf & vbCrLf & "処理は開始できませんでした。"
164 MsgBox gstrErrorMsg, _
165 vbOKOnly + vbCritical + vbSystemModal, "環境エラー"
166 bCheckAcrobatBatch = False
167 Exit Function
168 End If
169
170 'Acrobatが起動されているかをチェック
171 '※このチェックは絶対に必要！
172 ' FindWindow
173 ' http://msdn.microsoft.com/ja-jp/library/cc364634.aspx
174 '※注意：AcrobatInfo.exeもヒットする
175 Select Case glAcrobatVersion
176 Case 5
177 '※クラスは変動するのでタイトルで検索
178 strAcrobatClass = vbNullString
179 strAcrobatTitle = "Adobe Acrobat"
180 Case 6, 7
181 strAcrobatClass = "AdobeAcrobat"
182 strAcrobatTitle = vbNullString
183 Case 8, 9, 10
184 strAcrobatClass = "AcrobatSDIWindow"
185 strAcrobatTitle = vbNullString
186 End Select
187 lRet = FindWindow(strAcrobatClass, strAcrobatTitle)
188 If lRet > 0 Then
189 gstrErrorMsg = "[E12] Acrobatが起動しています。" & _
190 vbCrLf & "Acrobatを終了して下さい。" & _
191 vbCrLf & "またはAcrobatが終了するまで待って下さい。" & _
192 vbCrLf & vbCrLf & "処理は開始できませんでした。"
193 MsgBox gstrErrorMsg, _
194 vbOKOnly + vbCritical + vbSystemModal, "環境エラー"
195 bCheckAcrobatBatch = False
196 Exit Function
197 End If
198
199 '------------------------------------------------------
200 'シート上の入力データをチェック
201 Dim strKeyName As String
202 Dim strKeyNameK As String
203
204 Select Case glAcrobatVersion
205 Case 5, 6, 7, 8, 9
206 strKeyName = "シーケンス"
207 strKeyNameK = "バッチ処理"
208 Case Else
209 strKeyName = "アクション"
210 strKeyNameK = "アクションウイザード"
211 End Select
212
213 Dim lRow As Long '行
214 Dim lCol As Long '列
215 Const CON_TOP_SHHET = "MAIN" 'シート名
216
217 With Worksheets(CON_TOP_SHHET)
218 lRow = 7
219 lCol = 7
220 If Trim$(.Cells(lRow, lCol)) = "" Then
221 gstrErrorMsg = "[IE01] " & strKeyName & "名が" _
222 & "未入力です。" & vbCrLf & vbCrLf & _
223 "処理は開始できませんでした。"
224 MsgBox gstrErrorMsg, _
225 vbOKOnly + vbCritical + vbSystemModal, "環境エラー"
226 bCheckAcrobatBatch = False
227 Exit Function
228 End If
229 gstrRunBatchName = Trim$(.Cells(lRow, lCol)) '"PrEdit"
230
231 lRow = 11
232 lCol = 7
233 If Trim$(.Cells(lRow, lCol)) = "" Then
234 gstrErrorMsg = "[IE02] タイムアウト時間(秒)が" _
235 & "未入力です。" & vbCrLf & vbCrLf & _
236 "処理は開始できませんでした。"
237 MsgBox gstrErrorMsg, _
238 vbOKOnly + vbCritical + vbSystemModal, "環境エラー"
239 bCheckAcrobatBatch = False
240 Exit Function
241 ElseIf Not IsNumeric(Trim$(.Cells(lRow, lCol))) Then
242 gstrErrorMsg = "[IE02] タイムアウト時間(秒)が" _
243 & "未入力です。" & vbCrLf & vbCrLf & _
244 "処理は開始できませんでした。"
245 MsgBox gstrErrorMsg, _
246 vbOKOnly + vbCritical + vbSystemModal, "環境エラー"
247 bCheckAcrobatBatch = False
248 Exit Function
249 End If
250 glTimeOut = Trim$(.Cells(lRow, lCol))
251
252 End With
253
254 '------------------------------------------------------
255
256 Dim strSubKey As String 'サブキー
257 Dim strRegType As String 'レジストリ格納タイプ
258 Dim vValue As Variant 'レジストリの値
259 Dim strValue As String 'レジストリの値(文字列)
260 Dim i As Long '添字
261
262 Const CON_KAKU_1 = "[シーケンス実行の確認ダイアログボックスを表示(S)]"
263 Const CON_KAKU_2 = "[アクション実行の確認ダイアログを表示(S)]"
264 Const CON_KEI_1 = "[警告とエラーをログファイルに保存(A)]"
265
266 strSubKey = "Software\Adobe\Adobe Acrobat\" & _
267 strVersion & ".0\Batch"
268 lRet = GetRegistryValue(HKEY_CURRENT_USER, strSubKey, _
269 "bConfirmRun", strRegType, strMsg, vValue)
270 '※レジストリが存在しない場合はデフォルトで 1 の扱い
271 If lRet = 2 Then vValue = 1
272 If vValue = 0 Then
273 gstrErrorMsg = _
274 "[E13] Acroba/環境設定/" & strKeyNameK & _
275 vbCrLf & CON_KAKU_2 & vbCrLf & _
276 "チェックをオンにしてください。" & _
277 vbCrLf & vbCrLf & "処理は開始できませんでした。"
278 MsgBox gstrErrorMsg, _
279 vbOKOnly + vbCritical + vbSystemModal, _
280 "Acrobat 環境設定エラー"
281 bCheckAcrobatBatch = False
282 Exit Function
283 End If
284
285 lRet = GetRegistryValue(HKEY_CURRENT_USER, strSubKey, _
286 "bSaveLog", strRegType, strMsg, vValue)
287 '※レジストリが存在しない場合はデフォルトで 0 の扱い
288 If lRet = 2 Then vValue = 0
289 If vValue = 0 Then
290 gstrErrorMsg = _
291 "[E14] Acroba/環境設定/アクションウイザード" & strKeyNameK _
292 & vbCrLf & CON_KEI_1 & vbCrLf & _
293 "チェックをオンにしてください。" & _
294 vbCrLf & vbCrLf & "処理は開始できませんでした。"
295 MsgBox gstrErrorMsg, _
296 vbOKOnly + vbCritical + vbSystemModal, _
297 "Acrobat 環境設定エラー"
298 bCheckAcrobatBatch = False
299 Exit Function
300 End If
301
302 If vValue = 1 Then
303 strSubKey = "Software\Adobe\Adobe Acrobat\" & _
304 strVersion & ".0\Batch\cLogLocation"
305 lRet = GetRegistryValue(HKEY_CURRENT_USER, strSubKey, _
306 "sDI", strRegType, strMsg, vValue)
307 If lRet = 2 Then
308 gstrErrorMsg = "[E15] Acroba/環境設定/" & strKeyNameK _
309 & vbCrLf & CON_KEI_1 & vbCrLf & _
310 "[場所の選択(C)]ボタンで保存先フォルダを設定してください。" _
311 & vbCrLf & vbCrLf & "処理は開始できませんでした。"
312 MsgBox gstrErrorMsg, _
313 vbOKOnly + vbCritical + vbSystemModal, _
314 "Acrobat 環境設定エラー"
315 bCheckAcrobatBatch = False
316 Exit Function
317 End If
318 If strRegType = "REG_BINARY" Then
319 'バイナリーを文字に変換
320 strValue = ""
321 For i = 0 To UBound(vValue) - 1
322 strValue = strValue & Chr(vValue(i))
323 Next i
324 Else
325 strValue = vValue
326 End If
327
328 'レジストリからログ保存先フォルダを取得
329 strValue = Replace(strValue, "/", "\")
330 If Len(strValue) > 3 Then
331 gstrLogSavePath = Mid$(strValue, 2, 1) & ":\" & _
332 Mid$(strValue, 4, Len(strValue) - 1) & "\"
333 Else
334 gstrLogSavePath = Mid$(strValue, 2, 1) & ":\"
335 End If
336 If CON_TEST Then Debug.Print _
337 "gstrLogSavePath= '" & gstrLogSavePath & "'"
338
339 Else
340 '※このケースの発生は考えられないが。
341 gstrErrorMsg = _
342 "[E16] Acroba/環境設定/" & strKeyNameK & _
343 vbCrLf & CON_KEI_1 & vbCrLf & _
344 "[場所の選択(C)]のレジストリ値が不正です。" & _
345 vbCrLf & vbCrLf & "処理は開始できませんでした。"
346 MsgBox gstrErrorMsg, _
347 vbOKOnly + vbCritical + vbSystemModal, _
348 "Acrobat 環境設定エラー"
349 bCheckAcrobatBatch = False
350 Exit Function
351 End If
352
353 '------------------------------------------------------
354
355 'ログの保存先フォルダをチェック
356 '※内容が古い場合が有るので再チェック
357 If Dir$(gstrLogSavePath, vbDirectory) = "" Then
358 '定数のエラー
359 gstrErrorMsg = "[E17] ログファイルの保存先フォルダ [" & _
360 gstrLogSavePath & "] が存在しません。" & vbCrLf & _
361 "事前に作成ておいてください。" & vbCrLf & vbCrLf & _
362 "処理は開始できませんでした。"
363 MsgBox gstrErrorMsg, _
364 vbOKOnly + vbCritical + vbSystemModal, "Acrobat 環境設定エラー"
365 bCheckAcrobatBatch = False
366 Exit Function
367 End If
368
369 '------------------------------------------------------
370 Dim strCheck As String
371
372 'アクション名、バッチ名のチェック
373 If Len(gstrRunBatchName) <> _
374 LenB(StrConv(gstrRunBatchName, vbFromUnicode)) Then
375 'エラー：全角文字が含まれている
376 gstrErrorMsg = "[E18] " & strKeyName & "名のチェック " & _
377 vbCrLf & "[" & gstrRunBatchName & "]" & vbCrLf & _
378 "に半角英数字以外は使えません。" & vbCrLf & vbCrLf & _
379 "処理は開始できませんでした。"
380 MsgBox gstrErrorMsg, _
381 vbOKOnly + vbCritical + vbSystemModal, "入力エラー"
382 bCheckAcrobatBatch = False
383 Exit Function
384 Else
385 '英数字以外の文字が含まれていないかのチェック
386 For i = 0 To Len(gstrRunBatchName) - 1
387 strCheck = Mid(gstrRunBatchName, i + 1, 1)
388 If ("0" <= strCheck And _
389 strCheck <= "9") Or _
390 ("A" <= StrConv(strCheck, vbUpperCase) And _
391 StrConv(strCheck, vbUpperCase) <= "Z") Then
392 Else
393 gstrErrorMsg = "[E18] " & strKeyName & "名" & _
394 vbCrLf & "[" & gstrRunBatchName & "]" & vbCrLf & _
395 "半角英数字以外は使えません。" & vbCrLf & vbCrLf & _
396 "処理は開始できませんでした。"
397 MsgBox gstrErrorMsg, _
398 vbOKOnly + vbCritical + vbSystemModal, "入力エラー"
399 bCheckAcrobatBatch = False
400 Exit Function
401 End If
402 Next i
403 End If
404
405 'アクション名、バッチ名と同じファイルの登録チェック
406 '参照：http://acrobat-reader.nnn2.com/?p=123
407 Dim strEnvVariable As String '環境変数
408 Dim strSequencesPath As String 'アクション、バッチ保存フォルダ
409 Dim strSequencesFile As String 'アクション、バッチのファイル名
410 Dim strSequencesFileH As String 'アクション、バッチのファイル名の拡張子無し
411
412 strEnvVariable = Environ("APPDATA")
413 strSequencesPath = strEnvVariable & "\Adobe\Acrobat\" & _
414 strVersion & ".0\Sequences\" & gstrRunBatchName & ".sequ"
415 '※Dir関数は大文字小文字関係無い
416 strSequencesFile = Dir$(strSequencesPath, vbNormal)
417 If strSequencesFile = "" Then
418 gstrErrorMsg = "[E19] " & strKeyName & "名" & _
419 vbCrLf & "[" & gstrRunBatchName & "]" & vbCrLf & _
420 "が未登録です。" & vbCrLf & _
421 "再度確認してください。" & vbCrLf & vbCrLf & _
422 "処理は開始できませんでした。"
423 MsgBox gstrErrorMsg, _
424 vbOKOnly + vbCritical + vbSystemModal, "入力エラー"
425 bCheckAcrobatBatch = False
426 Exit Function
427 End If
428 '拡張子の前のファイル名
429 strSequencesFileH = Left$(strSequencesFile, _
430 Len(strSequencesFile) - 5)
431 '大文字、小文字も含めて完全チェックする
432 If strSequencesFileH <> gstrRunBatchName Then
433 'エラー：違う
434 gstrErrorMsg = "[E19] " & strKeyName & "名" & _
435 vbCrLf & "[" & gstrRunBatchName & "]" & vbCrLf & _
436 "が未登録です。" & vbCrLf & _
437 "再度確認してください。" & vbCrLf & vbCrLf & _
438 "処理は開始できませんでした。"
439 MsgBox gstrErrorMsg, _
440 vbOKOnly + vbCritical + vbSystemModal, "入力エラー"
441 bCheckAcrobatBatch = False
442 Exit Function
443 End If
444
445 bCheckAcrobatBatch = True
446
447 End Function
448
449 '*********************************************************
450 '
451 ' AutoItX3を使ってAcrobatのアクション(バッチ)処理を制御する
452 '
453 ' Create : 2014/03/22
454 ' Update : 2014/03/22
455 ' Vertion : 1.0.0
456 '
457 ' 備考 :
458 ' URL : http://pdf-file.nnn2.com/?p=786
459 ' その他 : 著作権等は主張しません。
460 ' 上記URLにコメントを頂けると嬉しいです。
461 '
462 ' 注意 : ウインドウの状態は「ProcessWalker Express」で監視
463 '
464 '*********************************************************
465
466 Sub subRun_Acrobat_Batch(ByRef strRunBatchName As String)
467
468 If CON_TEST Then Debug.Print _
469 "★開始★ " & Date & " " & Time
470
471 '----------------------------------------------------------
472
473 Dim lRet As Long '戻り値
474 Dim strTitle(10) As String 'ワーク・タイトル
475 Dim strText(10) As String 'ワーク・テキスト
476 Dim strClassID(10) As String 'ワーク・クラスID
477 Dim lTimeOut As Long 'タイムアウト時間(秒)
478 Dim i As Long '添字
479
480 ' Dim objAutit3 As Object
481 ' Set gobjAutoItX3 = CreateObject("AutoItX3.Control")
482 ' Dim gobjAutoItX3 As New AutoItX3Lib.AutoItX3
483
484 '自動化ソフトAutoItX3 のOLE初期化
485 ' Set gobjAutoItX3 = CreateObject("AutoItX3.Control")
486
487 For i = 0 To UBound(strTitle)
488 strTitle(i) = ""
489 strText(i) = ""
490 strClassID(i) = ""
491 Next i
492
493 'AutoItX3 ウィンドウテキスト検索モード：完全
494 lRet = gobjAutoItX3.AutoItSetOption("WinTitleMatchMode", 3)
495
496 '----------------------------------------------------------
497 '▼バッチシーケンス画面から該当するバッチを実行
498
499 Select Case glAcrobatVersion
500 ' Case 11
501 ' 'Acrobat 11 未対応
502 ' strTitle(0) = "アクションを管理"
503 ' strClassID(0) = "[CLASS:SysTreeView32; INSTANCE:1]"
504 Case 10
505 'Acrobat 10
506 strTitle(0) = "アクションを編集"
507 strClassID(0) = "[CLASS:SysTreeView32; INSTANCE:1]"
508 Case 8, 9
509 'Acrobat 8 , 9
510 strTitle(0) = "バッチシーケンス"
511 strClassID(0) = "[CLASS:SysTreeView32; INSTANCE:1]"
512 Case 6, 7
513 'Acrobat 6 , 7
514 strTitle(0) = "バッチシーケンス"
515 strClassID(0) = "[CLASS:Static; INSTANCE:2]"
516 ' Case Else
517 ' 'Acrobat 5 未対応
518 ' strTitle(0) = "バッチシーケンス"
519 ' strClassID(0) = "[CLASS:Static; INSTANCE:5]"
520 End Select
521 strText(0) = ""
522
523 '画面が出るまで待つ
524 lTimeOut = 5
525 'タイムアウト(秒)
526 With gobjAutoItX3
527 ' .Sleep CON_SLEEP
528 lRet = .WinWait(strTitle(0), strText(0), lTimeOut)
529 If Not .WinActive(strTitle(0), strText(0)) Then
530 .WinActivate strTitle(0), strText(0)
531 End If
532 lRet = .WinWaitActive(strTitle(0), strText(0), lTimeOut)
533 End With
534 ' lRet = gobjAutoItX3.WinWait(strTitle(0), strText(0), lTimeOut)
535 If lRet = 0 Then
536 'タイムアウト発生！
537 gstrErrorMsg = "[E21] Acrobatのバッチ処理" & vbCrLf & _
538 strTitle(0) & vbCrLf & _
539 "の画面がタイムアウト(" & lTimeOut & "秒)になりました。" & _
540 vbCrLf & "処理は中断しました。"
541 MsgBox gstrErrorMsg, _
542 vbOKOnly + vbCritical + vbSystemModal, "プログラム・エラー"
543 GoTo Skip_subRun_Acrobat_Batch:
544 End If
545
546 'リストボックスのフォーカスをアクティブにする
547 lRet = gobjAutoItX3.ControlFocus(strTitle(0), strText(0), _
548 strClassID(0))
549 If CON_TEST Then Debug.Print _
550 "ControlFocus=" & lRet & " E=" & gobjAutoItX3.Error
551
552 'リスト上の該当シーケンスを選択状態にする
553 lRet = gobjAutoItX3.ControlSend(strTitle(0), strText(0), _
554 strClassID(0), strRunBatchName, 1)
555 ' If lRet = 0 Then
556 ' '0=Error 1=OK
557 ' End If
558 If CON_TEST Then Debug.Print _
559 "シーケンスの選択状態の設定 ControlSend=" & _
560 lRet & " E=" & gobjAutoItX3.Error
561
562 Select Case glAcrobatVersion
563 ' Case 11
564 ' 'Acrobat 11
565 ' strTitle(1) = "アクションを管理"
566 ' strText(1) = "実行(&R)"
567 ' strClassID(1) = "[CLASS:Button; INSTANCE:7]"
568 Case 10
569 'Acrobat 10
570 strTitle(1) = "アクションを編集"
571 strText(1) = "実行(&R)"
572 strClassID(1) = "[CLASS:Button; INSTANCE:7]"
573 Case Else
574 'Acrobat 5, 6, 7, 8, 9
575 strTitle(1) = "バッチシーケンス"
576 strText(1) = "シーケンスを実行(&S)"
577 strClassID(1) = "[CLASS:Button; INSTANCE:5]"
578 End Select
579
580 'アクション(シーケンス)の実行ボタンをクリック
581 '「シーケンスを実行(&S)」
582 lRet = gobjAutoItX3.ControlClick(strTitle(1), strText(1), _
583 strClassID(1), "", 1)
584 ' If lRet = 0 Then
585 ' '0=Error 1=OK
586 ' End If
587 If CON_TEST Then Debug.Print _
588 "ControlClick=" & lRet & " E=" & gobjAutoItX3.Error
589
590 '----------------------------------------------------------
591 '▼「シーケンス実行の確認」画面の処理
592
593 Select Case glAcrobatVersion
594 Case 10 ', 11
595 'Acrobat 10, 11
596 strTitle(2) = "アクション : " & strRunBatchName
597 Case Else
598 'Acrobat 6, 7, 8, 9
599 strTitle(2) = "シーケンス実行の確認 : " & strRunBatchName
600 End Select
601 strText(2) = ""
602 strClassID(2) = ""
603
604 lTimeOut = 5 'タイムアウト(秒)
605 '画面が表示されたかを事前にチェック
606 With gobjAutoItX3
607 ' .Sleep CON_SLEEP
608 lRet = .WinWait(strTitle(2), strText(2), lTimeOut)
609 If Not .WinActive(strTitle(2), strText(2)) Then
610 .WinActivate strTitle(2), strText(2)
611 End If
612 lRet = .WinWaitActive(strTitle(2), strText(2), lTimeOut)
613 End With
614 ' lRet = gobjAutoItX3.WinWait(strTitle(2), strText(2), lTimeOut)
615 If lRet = 0 Then
616 'タイムアウト発生！
617 gstrErrorMsg = "[E22] Acrobatのバッチ処理" & vbCrLf & _
618 strTitle(2) & vbCrLf & _
619 "の画面がタイムアウト(" & lTimeOut & "秒)になりました。" & _
620 vbCrLf & vbCrLf & "処理は中断しました。" & _
621 vbCrLf & vbCrLf & "【重要】この後メモリ上にAcrobatアプリが残り" & _
622 vbCrLf & "Windowsが不安定になる場合があります。" & _
623 vbCrLf & "お手数ですが、OSの再起動をお願いします。"
624 MsgBox gstrErrorMsg, _
625 vbOKOnly + vbCritical + vbSystemModal, "プログラム・エラー"
626 '直前のAutoItコマンドで使用された最後のウィンドウを閉じます
627 gobjAutoItX3.WinClose "[LAST]", ""
628 GoTo Skip_subRun_Acrobat_Batch:
629 End If
630
631 'OKボタンをクリック
632 strTitle(3) = strTitle(2)
633 Select Case glAcrobatVersion
634 Case 10 ', 11
635 'Acrobat 10, 11
636 strText(3) = "次へ"
637 strClassID(3) = "[CLASS:Button; INSTANCE:2]"
638 Case Else
639 'Acrobat 6, 7, 8, 9
640 strText(3) = "OK"
641 strClassID(3) = "[CLASS:Button; INSTANCE:1]"
642 End Select
643
644 lRet = gobjAutoItX3.ControlClick(strTitle(3), strText(3), _
645 strClassID(3), "", 1)
646 ' If lRet = 0 Then
647 ' '0=Error 1=OK
648 ' End If
649 If CON_TEST Then Debug.Print _
650 "ControlClick=" & lRet & " E=" & gobjAutoItX3.Error
651
652 '----------------------------------------------------------
653 '▼「進行状況」画面の終了するまで監視
654 '※処理ファイルが０件の場合は次のWinWaitCloseは１が返り、
655 'Acrobatが 6,7,8,9 の時は「警告とエラー」画面が表示される。
656 'Acrobatが 10 の時は「アクションを編集」画面が表示される。
657
658 strTitle(4) = "進行状況" 'OR "[TITLE:進行状況]"
659 strText(4) = ""
660 strClassID(4) = ""
661
662 Dim iLoop As Long 'ループ添字
663
664 If CON_TEST Then Debug.Print _
665 strTitle(4) & " の監視終了(4):" & Time
666
667 gobjAutoItX3.Sleep CON_SLEEP '<-これを入れないと失敗する場合が有る
668 gobjAutoItX3.Sleep CON_SLEEP 'ココは2倍必要
669
670 '画面が一度は動作したかの確認
671 lRet = gobjAutoItX3.WinWaitClose(strTitle(4), strText(4), 1)
672 If lRet = 0 Then
673
674 'Debug.Print "**"
675 'Acrobat 6 ｴﾗｰ有り,ｾﾞﾛ件ﾃﾞｰﾀ,1件のみｴﾗｰﾃﾞｰﾀ
676 'Acrobat 7 ｴﾗｰ有り,ｾﾞﾛ件ﾃﾞｰﾀ,1件のみｴﾗｰﾃﾞｰﾀ
677 'Acrobat 8 ｴﾗｰ無し,ｴﾗｰ有り,ｾﾞﾛ件ﾃﾞｰﾀ,1件のみｴﾗｰﾃﾞｰﾀ
678 'Acrobat 9 ｴﾗｰ無し,ｴﾗｰ有り,ｾﾞﾛ件ﾃﾞｰﾀ,1件のみｴﾗｰﾃﾞｰﾀ
679 'Acrobat10 ｴﾗｰ無し,ｴﾗｰ有り,1件のみ正常ﾃﾞｰﾀ,1件のみｴﾗｰﾃﾞｰﾀ
680 Else
681 'Debug.Print "AA"
682 'Acrobat 6 ｴﾗｰ無し,1件のみ正常ﾃﾞｰﾀ
683 'Acrobat 7 ｴﾗｰ無し,1件のみ正常ﾃﾞｰﾀ
684 'Acrobat 8 1件のみ正常ﾃﾞｰﾀ
685 'Acrobat 9 1件のみ正常ﾃﾞｰﾀ
686 'Acrobat10 ｾﾞﾛ件ﾃﾞｰﾀ <-これのみ判断できる
687
688 If glAcrobatVersion = 10 Then
689 'Acrobat 10の場合
690 '[警告とエラー]画面は表示されない。
691 '[アクションを編集]画面にもどる
692 'クリップボードにエラーメッセージを入れて終了
693 gobjAutoItX3.ClipPut "Acrobat X アクション[" & strRunBatchName & _
694 "] 処理で該当データはゼロ件でした。" & _
695 Date & " " & Time
696 gstrErrorMsg = "該当データはゼロ件でした。"
697 GoTo Skip_subRun_Acrobat_Batch:
698 End If
699 End If
700
701 '注意：WinGetState でも WinExists でもエラーが有る時は
702 '見える画面が終了してもメモリ上では存在する場合がある
703 '「進捗状況」の画面がそれ！
704
705 '進捗画面の終了を監視
706 With gobjAutoItX3
707 For iLoop = 1 To glTimeOut
708 '1秒待機
709 .Sleep 1000
710 lRet = .WinGetState(strTitle(4), strText(4))
711 'Debug.Print "ON:進行状況:Loop " & iLoop & " " & lRet
712 If (lRet = 0 Or lRet = 1) Then
713 '画面は存在しない
714 '※この場合は戻り値は0では無く「1=ウィンドウが存在」でも返る
715 Exit For
716 End If
717 Next iLoop
718 End With
719
720 If Not (lRet = 0 Or lRet = 1) Then
721 'タイムアウト発生
722 gstrErrorMsg = "[E24] Acrobatのバッチ処理[" & vbCrLf & _
723 strTitle(4) & vbCrLf & "]の画面がタイムアウト(" & _
724 glTimeOut & "秒)になりました。" & _
725 vbCrLf & "処理は中断しました。"
726 MsgBox gstrErrorMsg, _
727 vbOKOnly + vbCritical + vbSystemModal, "プログラム・エラー"
728 '直前のAutoItコマンドで使用された最後のウィンドウを閉じます
729 gobjAutoItX3.WinClose "[LAST]", ""
730 GoTo Skip_subRun_Acrobat_Batch:
731 End If
732 If CON_TEST Then Debug.Print _
733 strTitle(4) & " の監視終了(4):" & Time & " " & iLoop
734
735 '----------------------------------------------------------
736 '▼「警告とエラー」画面の処理
737 '注意：「警告とエラー」画面が表示された段階でシステムの
738 'モニターを見ると進捗情報・画面はメモリ上に残っている。
739 '但し「警告とエラー」画面が無い時は進捗情報・画面も
740 'メモリ上では残って無い。
741
742 gobjAutoItX3.Sleep CON_SLEEP
743
744 Select Case glAcrobatVersion
745 Case 10 ', 11
746 'Acrobat 10 , 11
747 strTitle(5) = strRunBatchName
748 Case Else
749 'Acrobat 6, 7 , 8 , 9
750 strTitle(5) = "警告とエラー"
751 End Select
752 strText(5) = ""
753 strClassID(5) = ""
754
755 '「警告とエラー」画面が存在するかを確認
756 lRet = gobjAutoItX3.WinExists(strTitle(5), strText(5))
757 If lRet = 0 Then
758 '「警告とエラー」画面が存在しない
759 If CON_TEST Then Debug.Print _
760 "「警告とエラー」画面 Skip"
761 GoTo Skip_subRun_Acrobat_Batch:
762 End If
763
764 Dim strWinText As String
765
766 If 10 <= glAcrobatVersion Then
767 'Acrobat X(10) , XI(11) の時
768 gobjAutoItX3.Sleep CON_SLEEP
769 '[警告とエラー]文字が画面上に表示されているかを確認する
770 strWinText = gobjAutoItX3.WinGetText(strTitle(5), strText(5))
771 If InStr(strWinText, "警告とエラー") > 0 Then
772 '[警告とエラー]文字が見つかった
773 Else
774 '見つからなかった。エラーは無い。
775 'OKボタンをクリックする。
776 strClassID(5) = "[CLASS:Button; INSTANCE:1]"
777 lRet = gobjAutoItX3.ControlClick( _
778 strTitle(5), strText(5), strClassID(5), "", 1)
779 ' Debug.Print "ControlClick=" & lRet & " E=" & gobjAutoItX3.Error
780 If CON_TEST Then Debug.Print _
781 "「警告とエラー」明細・画面 Skip"
782 GoTo Skip_subRun_Acrobat_Batch:
783 End If
784
785 End If
786
787 gstrErrorMsg = "[警告とエラー]が有りました。"
788
789 Dim strK_Title As String '画面タイトル
790 Dim strK_Text As String '画面テキスト
791 Dim strK_ClassID As String '画面クラスID
792
793 '「警告とエラー」画面を閉じる
794 Select Case glAcrobatVersion
795 Case 10 ', 11
796 'Acrobat 10 , 11
797 strK_Title = strRunBatchName
798 strK_ClassID = "[CLASS:Button; INSTANCE:1]"
799 Case 8, 9
800 'Acrobat 8 , 9
801 strK_Title = "警告とエラー"
802 strK_ClassID = "[CLASS:Button; INSTANCE:1]"
803 Case Else
804 'Acrobat 6, 7
805 strK_Title = "警告とエラー"
806 strK_ClassID = "[CLASS:Static; INSTANCE:2]"
807 End Select
808 strK_Text = ""
809
810 gobjAutoItX3.Sleep CON_SLEEP
811 lRet = gobjAutoItX3.ControlClick(strK_Title, strK_Text, _
812 strK_ClassID, "", 1)
813 If lRet = 0 Then
814 '0=Error 1=OK
815 Debug.Print strK_Title & "★画面を閉じれなかった E=" & _
816 gobjAutoItX3.Error
817 End If
818
819 If CON_TEST Then _
820 Debug.Print "ControlClick=" & lRet & _
821 " E=" & gobjAutoItX3.Error
822
823 '画面を強制的に閉じる
824 lRet = gobjAutoItX3.WinClose(strK_Title)
825
826 Skip_subRun_Acrobat_Batch:
827
828 With gobjAutoItX3
829
830 '念の為に不要になった画面を強制的に閉じる
831 '※画面が残るとメモリ上にプロセスが残り
832 ' 次回でAcrobatが正常に起動しなくなる。
833 For i = UBound(strTitle) To 1 Step -1
834 If strTitle(i) <> "" Then
835 .Sleep CON_SLEEP
836 lRet = .WinClose(strTitle(i))
837 '.WinKill strTitle(i), ""
838 End If
839 Next i
840
841 If strTitle(2) <> "" Then
842 '選択で失敗した画面を閉じる
843 Select Case glAcrobatVersion
844 Case 10 ', 11
845 'Acrobat 10, 11
846 strTitle(2) = "アクション : "
847 Case Else
848 'Acrobat 6, 7, 8, 9
849 strTitle(2) = "シーケンス実行の確認 : "
850 End Select
851 'ウインドウテキスト検索モード：前方一致（デフォルト）
852 lRet = .AutoItSetOption("WinTitleMatchMode", 1)
853 lRet = .WinClose(strTitle(2))
854 '.WinKill strTitle(2), ""
855 End If
856
857 End With
858
859 'オブジェクトの強制開放
860 Set gobjAutoItX3 = Nothing
861
862 End Sub
863
864 '*********************************************************
865 '
866 ' 終了メッセージの表示
867 '
868 ' Create : 2014/03/22
869 ' Update : 2014/03/22
870 ' Vertion : 1.0.0
871 '
872 ' 備考 : 特に無し
873 '
874 ' URL : http://pdf-file.nnn2.com/?p=786
875 ' その他 : 著作権等は主張しません。
876 ' 上記URLにコメントを頂けると嬉しいです。
877 '
878 ' 注意 : 特に無し
879 '
880 '*********************************************************
881
882 Sub subPutMessage()
883
884 Dim lFileNo As Long 'ファイルNo
885 Dim strLogPath As String 'ファイルパス
886 Dim strMsg As String 'テキストファイルへのメッセージ
887
888 Const CON_INFO_MSG1 = vbCrLf & vbCrLf & _
889 "当プログラムで連続のバッチ処理を行うと" & vbCrLf & _
890 "Acrobatへの自動処理が失敗する場合が有るので" & vbCrLf & _
891 "次の処理を行う時は5秒以上の時間を置いて下さい。" & vbCrLf & _
892 "パソコンのCPU能力が低い時は１０秒以上置いて下さい。"
893
894 '※上記メッセージの理由：
895 'Acrobatアプリ本体が終了するのに数秒掛かる場合があります。
896 'その時はメモリ上にAcrobat本体が残っています。
897 'その状態で再起動を行うとAcrobat本体が不安定？になる場合が有るからです。
898
899 strMsg = gstrErrorMsg
900
901 strLogPath = gstrLogSavePath & _
902 Format(Date, "yyyy-mm-dd-") & _
903 Format(Time, "hh-mm-ss")
904
905 If gstrErrorMsg = "" Then
906 strLogPath = strLogPath & "-OK.txt"
907 strMsg = "エラーは有りませんでした。" & vbCrLf & _
908 Format(Date, "yyyy/mm/dd ") & _
909 Format(Time, "hh:mm:ss")
910 Else
911 strLogPath = strLogPath & "-ERROR.txt"
912 strMsg = gstrErrorMsg & vbCrLf & _
913 Format(Date, "yyyy/mm/dd ") & _
914 Format(Time, "hh:mm:ss")
915 End If
916
917 '結果をログファイルとして出力する
918 lFileNo = FreeFile
919 Open strLogPath For Output As #lFileNo
920 Print #lFileNo, strMsg
921 Close #lFileNo
922
923
924 If CON_TEST Then Debug.Print _
925 "★終了 " & Date & " " & Time
926
927 '終了メッセージを表示
928 MsgBox "[F00] 処理は終了しました。" _
929 & vbCrLf & gstrErrorMsg & _
930 vbCrLf & vbCrLf & Date & " " & Time & _
931 CON_INFO_MSG1, vbSystemModal, "結果報告"
932
933
934 End Sub
935
Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
*************************************************************
別モジュール
*************************************************************
001 Option Explicit
002
003 'Win32 APIを使用するための宣言
004
005 'レジストリ共通キー(親キー)
006 'Public Const HKEY_CLASSES_ROOT = &H80000000
007 Public Const HKEY_CURRENT_USER = &H80000001
008 'Public Const HKEY_CURRENT_CONFIG = &H80000005
009 'Public Const HKEY_DYN_DATA = &H80000006
010 Public Const HKEY_LOCAL_MACHINE = &H80000002
011 'Public Const HKEY_USERS = &H80000003
012 'Public Const ERROR_SUCCESS = 0&
013
014 'レジストリのデータタイプ
015 'Private Const REG_NONE = 0 '未定義のタイプ
016 Private Const REG_SZ = 1 'NULLで終わる文字列
017 Private Const REG_EXPAND_SZ = 2 '展開前の環境変数
018 Private Const REG_BINARY = 3 '任意の形式のバイナリデータ
019 Private Const REG_DWORD = 4 'ネイティブｄ形式の32ビット値
020 'Private Const REG_DWORD_LITTLE_ENDIAN = 4 'リトルエンディアン形式の32ビット値
021 'Private Const REG_DWORD_BIG_ENDIAN = 5 'ビッグエンディアン形式の32ビット値
022 'Private Const REG_LINK = 6 '別のサブキーへのシンボリックリンク
023 Private Const REG_MULTI_SZ = 7 'NULLで終わる文字列のリスト
024
025 Const ERROR_MORE_DATA = 234
026
027 'キーアクセスオプションを定義する為に必要
028 Private Const SYNCHRONIZE = &H100000
029 Private Const READ_CONTROL = &H20000
030 Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
031 Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
032 Private Const STANDARD_RIGHTS_ALL = &H1F0000
033
034 'キーアクセスオプション
035 Private Const KEY_CREATE_LINK = &H20 '他のサブキーへのシンボリックリンクの作成を許可
036 Private Const KEY_CREATE_SUB_KEY = &H4 'サブキーの作成を許可
037 Private Const KEY_ENUMERATE_SUB_KEYS = &H8 'サブキーの列挙を許可
038 Private Const KEY_NOTIFY = &H10 '変更通知を有効にする(WIN95は未対応)
039 Private Const KEY_QUERY_VALUE = &H1 'サブキーの値の参照を許可
040 Private Const KEY_SET_VALUE = &H2 'サブキーの書き込みを許可
041 'KEY_CREATE_SUB_KEY + KEY_SET_VALUE
042 'ウィンドウハンドル取得
043 Public Declare Function FindWindow Lib _
044 "user32" Alias "FindWindowA" _
045 (ByVal lpClassName As String, _
046 ByVal lpWindowName As String) As Long
047
048 'Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or _
049 ' KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
050 ' 'KEY_EXECUTE + KEY_NOTIFY
051 Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
052 KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
053 'KEY_CREATE_LINK + KEY_READ + KEY_WRITE
054 'Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
055 ' KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
056 ' KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
057 ' 'KEY_READ
058
059 'Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
060 'Const KEY_READ = &H20019 ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
061 ' ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
062 ' ' SYNCHRONIZE))
063
064 '戻り値
065 Private Const ERROR_SUCCESS = 0& 'エラー無し
066
067 '-------------------------------------------
068
069 Private Type VS_FIXEDFILEINFO
070 dwSignature As Long
071 dwStrucVersion As Long
072 dwFileVersionMS As Long
073 dwFileVersionLS As Long
074 dwProductVersionMS As Long
075 dwProductVersionLS As Long
076 dwFileFlagsMask As Long
077 dwFileFlags As Long
078 dwFileOS As Long
079 dwFileType As Long
080 dwFileSubtype As Long
081 dwFileDateMS As Long
082 dwFileDateLS As Long
083 End Type
084
085 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
086 (dest As Any, source As Any, ByVal numBytes As Long)
087
088 'レジストリのハンドルを解放する
089 Public Declare Function RegCloseKey Lib "ADVAPI32" _
090 (ByVal hKey&) As Long
091
092 'レジストリのキーを開ける(ハンドルの確保）
093 Public Declare Function RegOpenKeyEx Lib "ADVAPI32" _
094 Alias "RegOpenKeyExA" (ByVal hKey&, ByVal lpSubKey$, _
095 ByVal ulOptions&, ByVal samDesired&, phkResult&) As Long
096
097 'レジストリの値を取得する(DWORD)
098 Public Declare Function RegQueryValueExstr Lib "ADVAPI32" _
099 Alias "RegQueryValueExA" (ByVal hKey&, _
100 ByVal lpValueName$, ByVal lpReserved&, ByVal lpType&, _
101 ByVal lpData$, lpcbData&) As Long
102
103 'レジストリの値を取得する(テキスト)
104 Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
105 Alias "RegQueryValueExA" _
106 (ByVal hKey As Long, ByVal lpValueName As String, _
107 ByVal lpReserved As Long, lpType As Long, lpData As Any, _
108 lpcbData As Long) As Long
109
110 'ファイルのバージョン情報のサイズを取得する
111 Public Declare Function GetFileVersionInfoSize Lib _
112 "Version.dll" Alias "GetFileVersionInfoSizeA" _
113 (ByVal lptstrFilename As String, lpdwHandle As Long) _
114 As Long
115
116 'ファイルのバージョン情報を取得する
117 Public Declare Function GetFileVersionInfo Lib "Version.dll" _
118 Alias "GetFileVersionInfoA" _
119 (ByVal lptstrFilename As String, ByVal dwHandle As Long, _
120 ByVal dwLen As Long, lpData As Any) As Long
121
122 Public Declare Function VerQueryValue Lib "Version.dll" _
123 Alias "VerQueryValueA" (pBlock As Any, _
124 ByVal lpSubBlock As String, lplpBuffer As Any, _
125 puLen As Long) As Long
126
127 Public Declare Sub MoveMemory Lib "kernel32.dll" _
128 Alias "RtlMoveMemory" (Destination As Any, _
129 source As Any, ByVal length As Long)
130
131 '時間指定してCPUをシステムに戻す
132 Public Declare Sub Sleep Lib "kernel32.dll" _
133 (ByVal dwMilliseconds As Long)
134
135
136 '**************************************************
137 '
138 ' Acrobat , Adobe Reader アプリのインストールパスと
139 ' アプリケーションのバージョンを取得する
140 '
141 ' Get the version and application path
142 ' for acrobat and adobe reader.
143 '
144 ' Create : 2013/10/08
145 ' Update :
146 ' Vertion : 1.0.0
147 '
148 ' 引数1 : strApp As String (IN)
149 ' 'Acrobat' Acrobatの処理
150 ' 'Reader' Adobe Readerの処理
151 ' 引数2 : strPath As String (OUT)
152 ' Adobe アプリケーションパス
153 ' 引数3 : strVersion As String (OUT)
154 ' アプリケーションのバージョン番号 4～11
155 ' 引数4 : strMsg As String (OUT)
156 ' エラーメッセージ
157 ' ""はエラー無し
158 '
159 ' 戻り値 : True 正常処理
160 ' False 実行エラー等
161 '
162 ' 備考 :
163 ' 1. 以下のサイトの情報を元に作成しました
164 ' http://helpx.adobe.com/jp/acrobat/kb/511265.html
165 ' URL : http://pdf-file.nnn2.com/?p=767
166 ' その他 : 著作権等は主張しません。
167 ' 上記URLにコメントを頂けると嬉しいです。
168 '
169 '**************************************************
170
171 Public Function Get_Adobe_App_Info_nnn2( _
172 ByVal strApp As String, _
173 ByRef strPath As String, _
174 ByRef strVersion As String, _
175 ByRef strMsg As String) As Boolean
176
177 On Error GoTo Err_Get_Adobe_App_Info_nnn2:
178
179 Dim strFileVersion As String
180 Dim strProductVersion As String
181 Dim strSubKey As String
182 Dim strRootKey As String
183 Dim InstallPathReg As Long
184 Dim lLength As Long
185 Dim lRet As Long
186 Dim strName As String
187
188 strMsg = ""
189 strRootKey = HKEY_LOCAL_MACHINE
190 If strApp = "Acrobat" Then
191 'Acrobat Reg
192 strSubKey = "SOFTWARE\Microsoft\Windows\" & _
193 "CurrentVersion\App Paths\Acrobat.exe"
194 Else
195 'Adobe Reader Reg
196 strSubKey = "SOFTWARE\Microsoft\Windows\" & _
197 "CurrentVersion\App Paths\AcroRd32.exe"
198 End If
199
200 'キーをオープンしてハンドルを得る
201 lRet = RegOpenKeyEx(strRootKey, strSubKey, 0, 1, _
202 InstallPathReg)
203
204 'バッファを確保する
205 strPath = String(250, Chr(0))
206 lLength = Len(strPath) '長さ
207
208 '"*.exe"エントリから既定のレジストリを得る
209 strName = ""
210 lRet = RegQueryValueExstr(InstallPathReg, strName, _
211 0, 0, strPath, lLength)
212
213 'レジストリ値の存在チェック
214 strPath = Trim$(Replace(strPath, Chr(0), " "))
215 If strPath = "" Then
216 'エラー：アプリケーションは未インストール
217 strMsg = "Not Found Adobe apllication"
218 strVersion = vbNullString
219 Exit Function
220 End If
221
222 'アプリのフルパスを出力
223 strPath = Left$(strPath, InStr(strPath, ".exe") + 3)
224
225 'ハンドルを閉じる
226 Call RegCloseKey(InstallPathReg)
227
228 '***************************************************
229 '取得したパスの exeファイル情報を取得する
230 '***************************************************
231
232 Dim lngSizeOfVersionInfo As Long
233 Dim lngDummyHandle As Long
234 Dim bytDummyVersionInfo() As Byte
235 Dim lngPointerVersionInfo As Long
236 Dim lnglLengthVersionInfo As Long
237 Dim udtVSFixedFileInfo As VS_FIXEDFILEINFO
238
239 'バージョン情報のサイズを取得
240 lngSizeOfVersionInfo = GetFileVersionInfoSize(strPath, _
241 lngDummyHandle)
242
243 'ダミー変数の領域を確保
244 ReDim bytDummyVersionInfo(lngSizeOfVersionInfo - -1)
245
246 'バージョン情報を取得
247 lRet = GetFileVersionInfo(strPath, 0, _
248 lngSizeOfVersionInfo, bytDummyVersionInfo(0))
249
250 'バージョン情報リソースのルートブロックを取得
251 lRet = VerQueryValue(bytDummyVersionInfo(0), "\", _
252 lngPointerVersionInfo, lnglLengthVersionInfo)
253
254 '取得したルートブロックをバージョン情報の構造体へ移動
255 MoveMemory udtVSFixedFileInfo, _
256 ByVal lngPointerVersionInfo, Len(udtVSFixedFileInfo)
257
258 With udtVSFixedFileInfo
259 'ファイルバージョンを取り出し
260 strFileVersion = _
261 CStr((.dwFileVersionMS \ 2 ^ 16) And &HFFFF&) & "." & _
262 CStr(.dwFileVersionMS And &HFFFF&) & "." & _
263 CStr((.dwFileVersionLS \ 2 ^ 16) And &HFFFF&) & "." & _
264 CStr(.dwFileVersionLS And &HFFFF&)
265
266 '製品バージョンを取り出し
267 strProductVersion = _
268 CStr((.dwProductVersionMS \ 2 ^ 16) And &HFFFF&) & "." & _
269 CStr(.dwProductVersionMS And &HFFFF&) & "." & _
270 CStr((.dwProductVersionLS \ 2 ^ 16) And &HFFFF&) & "." & _
271 CStr(.dwProductVersionLS And &HFFFF&)
272
273 strVersion = CStr((.dwProductVersionMS \ 2 ^ 16) And &HFFFF&)
274
275 End With
276
277 '確認用
278 ' Debug.Print "strFileVersion =" & strFileVersion
279 ' Debug.Print "strProductVersion=" & strProductVersion
280
281 Get_Adobe_App_Info_nnn2 = True
282 Exit Function
283
284 Err_Get_Adobe_App_Info_nnn2:
285 strMsg = "Run Time Error" & vbCrLf & Err.Number & _
286 vbCrLf & Err.Description
287 Get_Adobe_App_Info_nnn2 = False
288 End Function
289
290 '*********************************************************
291 '
292 ' レジストリから値を取得する
293 '
294 ' Get the value from the registry.
295 '
296 ' Create : 2014/03/22
297 ' Update :
298 ' Vertion : 1.0.0
299 '
300 ' 引数1 : lRootKey As Long (IN)
301 ' ルートキーの値
302 ' 引数2 : strSubKey As String (IN)
303 ' サブキーの値
304 ' 引数3 : strValueName As String (IN)
305 ' 取得する値の名前
306 ' 引数4 : strType As String (OUT)
307 ' 取得する値のタイプ
308 ' "REG_DWORD","REG_SZ","REG_BINARY"
309 ' 引数5 : strMsg As String (OUT)
310 ' エラーメッセージ
311 ' 引数6 : vaValue As Variant (OUT)
312 ' レジストリから取得した値
313 ' 引数7 : vDefaultValue As Variant (IN)
314 ' オプション：未使用
315 '
316 ' 戻り値 : 0 エラー無し
317 ' 2 該当するサブキーが存在いしない
318 ' 上記以外 その他のエラー
319 '
320 ' 備考 :
321 '
322 ' URL : http://pdf-file.nnn2.com/?p=786
323 '
324 ' その他 : 著作権等は主張しません。
325 ' 上記URLにコメントを頂けると嬉しいです。
326 '
327 ' 参照URL : 基本部分を参考にしました
328 ' http://www.devx.com/vb2themax/Tip/19134
329 '
330 ' Windows API memo：
331 ' RegOpenKeyEx
332 ' 指定されたレジストリキーを開きます
333 ' http://msdn.microsoft.com/ja-jp/library/cc429950.aspx
334 ' RegQueryValueEx
335 ' 指定されたレジストリキーに所属している、指定された
336 ' レジストリエントリのデータ型とデータを取得します。
337 ' http://msdn.microsoft.com/ja-jp/library/cc429931.aspx
338 ' CopyMemory
339 ' 指定されたメモリブロックの内容を、他の場所へコピー
340 ' http://msdn.microsoft.com/ja-jp/library/cc430033.aspx
341 ' RegCloseKey
342 ' 指定されたレジストリキーのハンドルを閉じます
343 ' http://msdn.microsoft.com/ja-jp/library/cc429930.aspx
344 '
345 '*********************************************************
346
347 Function GetRegistryValue( _
348 ByVal lRooKey As Long, _
349 ByVal strSubKey As String, _
350 ByVal strValueName As String, _
351 ByRef strType As String, _
352 ByRef strMsg As String, _
353 ByRef vaValue As Variant, _
354 Optional vDefaultValue As Variant) As Long
355
356 Dim lRet As Long '戻り値
357 Dim lhandle As Long
358 Dim lResLong As Long
359 Dim strResString As String
360 Dim btResBinary() As Byte
361 Dim length As Long '長さ
362 Dim lRetVal As Long
363 Dim lValueType As Long 'レジストリ格納タイプ
364
365 GetRegistryValue = 0
366 vaValue = ""
367
368 ' Prepare the default result
369 vaValue = IIf(IsMissing(vDefaultValue), Empty, vDefaultValue)
370
371 ' Open the key, exit if not found.
372 'レジストリのサブキーのオープン(読み込みのみ)
373 lRet = RegOpenKeyEx(lRooKey, strSubKey, 0, KEY_READ, lhandle)
374 If lRet = 2 Then
375 '該当サブキーは存在しない
376 GetRegistryValue = lRet
377 strMsg = "該当サブキーは存在しない"
378 Exit Function
379 ElseIf lRet <> ERROR_SUCCESS Then
380 GetRegistryValue = lRet
381 strMsg = "RegOpenKeyEx" & vbCrLf & "エラーコード : " & lRet
382 MsgBox strMsg, vbOKOnly, "サブキーのオープン"
383 Exit Function
384 End If
385
386 ' prepare a 1K receiving btResBinary
387 length = 1024
388 ReDim btResBinary(0 To length - 1) As Byte
389
390 ' read the registry key
391 lRetVal = RegQueryValueEx(lhandle, strValueName, 0, lValueType, _
392 btResBinary(0), length)
393 ' if btResBinary was too small, try again
394 If lRetVal = ERROR_MORE_DATA Then
395 ' enlarge the btResBinary, and read the value again
396 ReDim btResBinary(0 To length - 1) As Byte
397 lRetVal = RegQueryValueEx(lhandle, strValueName, 0, _
398 lValueType, btResBinary(0), length)
399 End If
400
401 ' return a value corresponding to the value type
402 Select Case lValueType
403 Case REG_DWORD
404 CopyMemory lResLong, btResBinary(0), 4
405 vaValue = lResLong
406 strType = "REG_DWORD"
407 ' Debug.Print strValueName & " (REG_DWORD) " & vaValue
408 Case REG_SZ, REG_EXPAND_SZ
409 ' copy everything but the trailing null char
410 strResString = Space$(length - 1)
411 CopyMemory ByVal strResString, btResBinary(0), length - 1
412 vaValue = strResString
413 strType = "REG_SZ,REG_EXPAND_SZ"
414 ' Debug.Print _
415 ' strValueName & " (REG_SZ,REG_EXPAND_SZ) '" & vaValue & "'"
416 Case REG_BINARY
417 ' resize the result btResBinary
418 If length <> UBound(btResBinary) + 1 Then
419 ReDim Preserve btResBinary(0 To length - 1) As Byte
420 End If
421 vaValue = btResBinary()
422 strType = "REG_BINARY"
423 ' Debug.Print strValueName & " (REG_BINARY) " & length
424 Case REG_MULTI_SZ
425 ' copy everything but the 2 trailing null chars
426 strResString = Space$(length - 2)
427 CopyMemory ByVal strResString, btResBinary(0), length - 2
428 vaValue = strResString
429 strType = "REG_MULTI_SZ"
430 ' Debug.Print strValueName & " (REG_MULTI_SZ) "
431 Case Else
432 GetRegistryValue = 99
433 strType = ""
434 RegCloseKey lhandle
435 Err.Raise 1001, , "Unsupported value type"
436 End Select
437
438 ' close the registry key
439 RegCloseKey lhandle
440
441 End Function
442
Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
＜ サンプル一覧 ＞
管理人用のメモ
これ以降はサイト管理人のメモです。
見なくても結構です。
残された課題
- タイムアウトになった後に不要になった画面を強制的に閉じるてるつもりです。
それでも残ってしまう、のは・・・。
メモリ上にAcrobatアプリが残ったままになってしまう。
特に E22 エラー の強制処理が効いてない場合がある。
＜ サンプル一覧 ＞