関数：コマンドラインの起動

機能

コマンドラインを起動するVBA関数です。

起動されたアプリの終了を待ちます。終了コード、標準出力、標準エラー出力も取得します。

形式

001 Public Function RunCommandLineEX( _
002         ByVal strInCommand As String, _
003         ByVal strInWorkFolder As String, _
004         ByVal lInErrCount As Long, _
005         ByRef lInErrCode() As Long, _
006         ByRef strOutFile() As String, _
007         ByRef strOutErrMsg As String, _
008         ByRef lOutRetCode As Long) As Boolean

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

引数

In：関数の呼び出し側でセットする項目

Out：VBA関数側から返される項目

第１引数：strInCommand As String (In)
Dos上で実行するコマンドラインの文字列
第２引数：strInWorkFolder As String (In)
一時的な作業フォルダ。空白時はExcelファイルの実行フォルダを使う。
第３引数：lInErrCount As Long (In)
コマンドラインの終了を判定する終了コードの数。
無指定時は-1をセット。
第４引数：lInErrCode() As Long (In)
コマンドラインの終了を判定する終了コードを配列にセット。
判らない時はlInErrCountに-1をセット。
第５引数：strOutFile() As String (Out)
コマンドラインの実行結果がセットされる。
strOutFile(0)：標準出力の内容
strOutFile(1)：標準エラー出力の内容
第６引数：strOutErrMsg (Out)
関数内のエラーメッセージ。エラー無しは ""。
第７引数：lOutRetCode As Long (Out)
コマンドラインの終了コードがセットされる。

戻り値

True : 正常処理
False : 異常処理
strOutErrMsg の内容を確認する。

関数の正常、エラーの判定

RunCommandLineEX の戻り値はプログラム内部のエラー判定に使われるだけです。これにFalseが返されるとstrOutErrMsgにエラーメッセージがセットされます。True が返されてもコマンドラインが正常終了したとは限りません。コマンドライン・アプリの実行結果とは関係無いです。　　
コマンドラインの実行結果は
strOutFile(0)：標準出力
strOutFile(1)：標準エラー出力
の内容をチェックします。
- 標準エラー出力が有るからといってエラーとは限りません。
  理由：正常処理の結果を標準エラー出力側に出すアプリも有るからです。
- 標準出力だけが有るからといって正常終了とは限りません。
  理由：エラーメッセージを標準出力側に出力するアプリも有るからです。オプションの記述ミスを「--help」扱いで標準出力に出す傾向が有ります。

VBAサンプル

Poppler の pdfinfo.exe をコマンドライン起動して PDFファイルの各種の文書情報を取得します。

終了コードが 0 , 1 , 2 , 3 , 99 で返されたら終了と判断します。
作業フォルダは起動Excelファイルのフォルダとします。
オプションは「-box」。

Download：cLine-RunCommandLineEX.xls

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

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

実行結果

001 lCnt=1 259
002 ・・・・・・
003 lCnt=127 259
004 Exit=0:127
005 strErr=
006 msg1 i(0)=Title:          Title タイトル
007 msg1 i(1)=Subject:        Subject
008 msg1 i(2)=Keywords:       Keywords
009 msg1 i(3)=Author:         Author　作成者
010 msg1 i(4)=Creator:        Creator
011 msg1 i(5)=Producer:       My Producer
012 msg1 i(6)=CreationDate:   08/21/52 20:17:58 ???? (?W????)
013 msg1 i(7)=ModDate:        02/17/63 06:36:36 ???? (?W????)
014 msg1 i(8)=Tagged:         no
015 msg1 i(9)=UserProperties: no
016 msg1 i(10)=Suspects:       no
017 msg1 i(11)=Form:           none
018 msg1 i(12)=JavaScript:     no
019 msg1 i(13)=Pages:          16
020 msg1 i(14)=Encrypted:      no
021 msg1 i(15)=Page size:      480 x 453.12 pts
022 msg1 i(16)=Page rot:       0
023 msg1 i(17)=MediaBox:           0.00     0.00   480.00   453.12
024 msg1 i(18)=CropBox:            0.00     0.00   480.00   453.12
025 msg1 i(19)=BleedBox:           0.00     0.00   480.00   453.12
026 msg1 i(20)=TrimBox:            0.00     0.00   480.00   453.12
027 msg1 i(21)=ArtBox:             0.00     0.00   480.00   453.12
028 msg1 i(22)=File size:      235606 bytes
029 msg1 i(23)=Optimized:      no
030 msg1 i(24)=PDF version:    1.7
031 msg1 i(25)=

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

備考

標準出力、標準エラー出力共にUTF-8のテキストなっています。よってVBA内部に読み込む時は ADODB.Stream を使ってコード変換をしています。
実行結果の CreationDate と ModDate で一部が文字化けを起こしています。文字化けをしないで読み込むにはCON_READ = Flase にして②のロジックで読み込む必要が有ります。

技術メモ

標準出力は「xxx.exe > out.txt」でテキスト出力出来ます。
標準エラー出力は「xxx.exe 2> out.txt」でテキスト出力出来ます。
コマンドラインの終了コードは WindowsAPI GetExitCodeProcess の第二引数で取得できます。
コマンドラインの実行中時の終了コードは 259 でした。

動作確認環境

Windows 10 64bit Pro + Excel 2007 (SP3)

＜　サンプル/関数へ戻る＞

PDF

関数：コマンドラインの起動

機能

形式

引数

戻り値

関数の正常、エラーの判定

VBAサンプル

実行結果

備考

技術メモ

動作確認環境

コメントを残す

VBA(Excel)からAcrobat経由でPDFをプログラミング操作(OLE:IAC)する