Acrobat のアクション、バッチ処理を実行する (Acrobat 6~10)

TOP > サンプル/関数 > *


概要

Acrobat アプリケーションのアクション処理(バッチ処理)をプログラムで実行します。

実行から終了までをプログラムで監視し、結果はログテキストでファイル出力します。

Acrobat X アクション処理をVBAで操作する
  • 通常ではAcrobat の全バージョン( 5 ~ 11 )はAcrobat OLE を使ってもアクションやバッチ処理を起動する事すら出来ないです。
    そこで、当サンプルは Acrobat OLE と自動化ソフトの AutoItX3 OLE を連携させて全てをプログラミング操作で行います。
      
  • 自動化ソフト AutoIt は商用利用も含めてフリーでの使用が可能になっています。
    VBA のSendKeys ステートメントより安定、高機能な仕様になっています。 
      

動作環境

当サイトが出した結果です。
必ず自分の環境で動作確認をしてください。

Acrobat動作備考
4XAcrobat 4.0 ※Windows 98SE + Excel 2000
※バッチ処理自体が未サポート
5XAcrobat 5.0.5 + Excel 2003
※当サンプルでは対応しません。予定も無し
6OKAcrobat 6.0.6 Pro + Excel 2003
7OKAcrobat 7.1.4 Pro + Excel 2003
8OKAcrobat 8.3.1 Pro + Excel 2003
9OKAcrobat 9.5.5 Extended + Excel 2003
10OKAcrobat X (10.1.9) Extended + Excel 2003
11XAcrobat 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 以下はバッチ処理)

  • 「アクション実行の確認ダイアログを表示」 をオン
      
  • 「警告とエラーをログ・ファイルに保存」 をオン
      
  • 「場所の選択」 で保存フォルダを指定
      

を事前に設定しておきます。 (必須)

Acrobat 10 の環境設定でアクションウイザードを設定

4. Acrobat にアクション(バッチ処理)を事前登録

起動するアクション(バッチシーケンス)を事前に登録しておく必要が有ります。

アクション名(バッチシーケンス名)は日本語も使えますが、当サンプルのプログラム仕様上の問題で半角英数字でお願いします。

5. サンプルのダウンロード

ダウンロードしたら、解凍して AutoRun_Acrobat_Action_100.xls ファイルを取り出します。


サンプルの実行

AutoRun_Acrobat_Action_100.xls ファイルを実行します。

1. 最初に以下のシートが表示されます。

読んでください。

Acrobat のアクション、バッチ処理を実行する (Acrobat 6~10)

2. MAIN シートを開きます。

  1. 上記で登録したアクション名(バッチのシーケンス名)
      
  2. Acrobat が処理する時の予想タイムアウト時間(秒)

をシート上に入力します。

最後に「実行」ボタンをマウスでクリックします

Acrobat のアクション、バッチ処理を実行する (Acrobat 6~10)

3. 良ければ、「OK」ボタンをマウスでクリックします。

Acrobat のアクション、バッチ処理を実行する (Acrobat 6~10)

この後で、プログラム内部で各種の事前チェックが行われます。

問題が有れば、以下の様なエラーが表示されます。

Acrobat のアクション、バッチ処理を実行する (Acrobat 6~10)

4. Acrobat のアクション処理(バッチ処理)が終了するまで待ちます。

終了すると以下の様な終了ダイアログ画面が表示されます。

同時にAcrobat の環境設定の「場所の選択」 で指定したフォルダにログファイルを出力します。

Acrobat のアクション、バッチ処理を実行する (Acrobat 6~10)

備考

  1. Acrobat XI (v11) バージョンに関してはユーザーインターフェースが全く変わってしまうので、別サンプルで対応したいと考えています。
    但し、AutoItX3 の全く別の機能を使う必要があると思われるので、もう少し慣れてから考えたいです。
      
  2. サンプルはExcel VBA で提供してます。
    VBAは歴史の古いBASIC言語なので他のプログラミングに移行しやすいと考えている。
     
  3. VBAにはSendKeysステートメントが有ります。
    しかし、キーボード操作を簡単にシミュレーションは出来るが、安定性に欠けます。
    アプリケーションの操作には向いてない。
      
  4. ソース内部に大量のコメントが開発時のメモとして有ります。
    使用時は注意し削除してください。
     
  5. 不具合は出来るだけ対応したいと思いますが、時間日数等の保証は全く出来ません。
      
  6. 活用できた場合は、どの様な使い方をしたかのコメントを頂けると助かります。
    またカスタマイズした箇所等の情報も頂けると嬉しいです。
    今後に活かしたいと思ってますのでよろしくお願い致します。
      
  7. 自動化ソフト AutoItX3 に関する技術的な質問に返答できる知識を当サイト管理者はまだ持っていません。
    その前提でコメント投稿を開放します。
     

注意事項

  1. アクション名、又はバッチ名は半角の英数字で登録してください。
    それ以外の文字種を使うとAutoItX3 操作が失敗するかもしれません。
      
  2. Acrobat 5 , Acrobat XI は当サンプルでは対応しません。
    理由 Acrobat 5 :古いソフトで有り、サポート・メンテナンスに無理が有る。
    理由 Acrobat XI :画面UIが変更になって、当サンプルでは全く対応不可。
     
  3. AcrobatInfo.exe がバックグランドで勝手に動いて当サンプルの動作に支障を出るかもしれません。
    当サンプルを元に作ったアクション処理(バッチ処理)プログラムを使う時は、このAcrobatInfo.exe一時停止するような措置を考えて下さい。
    ※当サイトでは自己責任で AcrobatInfo.exe をリネームして、一時的に停止させました。
      
  4. VBAのSendKeysステートメントよりは自動化ソフト AutoItX3 OLE の方が、安定して使えます。
    但し、自動化ソフト AutoItX3 は基本が画面操作になるので非常にデリケートなプログラミングが必要になります。
    動作環境の影響も少なからず受け、操作失敗につながることもありますので、問題が出たと思われる時は、まずは Windowsの再起動をお勧めします。 
       
  5. Acrobat X (v10) の以下のアクション実行確認画面に「このアクションには、以後表示しない」が表示されていますが、決してオンにしないで下さい。
    動作を正確に監視する上で以下の画面表示は絶対に必要です。
    間違ってオンした場合は、一旦アクションを削除して、再度登録し直してください。
      
    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

  1. F8キーでステップ実行するとAutoItX3ステートメントが失敗する場合が有るので、Debug.Printでトレースを取るようにしてください。
     
  2. Acrobatの参照設定 をしています。
     
  3. 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 '※処理ファイルが0件の場合は次のWinWaitCloseは1が返り、 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能力が低い時は10秒以上置いて下さい。" 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 'ネイティブd形式の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編)
 

サンプル一覧


管理人用のメモ

これ以降はサイト管理人のメモです。

見なくても結構です。

残された課題

  1. タイムアウトになった後に不要になった画面を強制的に閉じるてるつもりです。
    それでも残ってしまう、のは・・・。
    メモリ上にAcrobatアプリが残ったままになってしまう。
    特に E22 エラー の強制処理が効いてない場合がある。
        

サンプル一覧

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

CAPTCHA


出来るだけ早く返答する様には心がけています。
が、遅くなる時もありますのでご了承ください。


SAMURAI Plugin

コメントをする時は出来れば以下もお願いします。

  • OS名 バージョン
  • Acrobat バージョン
  • ツール(Excel等) バージョン
コメントにサンプルコードを入れるとエラーになる場合が有ります。その時はコードの前後に <code> ・・・</code> タグを入れてください。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください