待ち、その後、セルの書式設定 - 同期コマンドを実行し

Question

私はシェルコマンドを使用して呼び出す実行可能があります。

Shell (ThisWorkbook.Path & "\ProcessData.exe") 

実行ファイルは、いくつかの計算を行いますが、その後、Excelに戻って結果をエクスポートします。私は彼らがエクスポートされた後の結果の形式を変更することができるようにしたい。

つまり、実行ファイルがタスクを完了し、データをエクスポートし、次に次のコマンドをフォーマットするまで、まずシェルコマンドがWAITする必要があります。

私はShellandwait()を試しましたが、大したことはありませんでした。

私がいた：

Sub Test() 

ShellandWait (ThisWorkbook.Path & "\ProcessData.exe") 

'Additional lines to format cells as needed 

End Sub 

は残念ながら、まだ、フォーマットが実行終了する前に最初に行われます。

ただ参考のために、ここでShellandWait

' Start the indicated program and wait for it 
' to finish, hiding while we wait. 


Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long 
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long 
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long 
Private Const INFINITE = &HFFFF 


Private Sub ShellAndWait(ByVal program_name As String) 
Dim process_id As Long 
Dim process_handle As Long 

' Start the program. 
On Error GoTo ShellError 
process_id = Shell(program_name) 
On Error GoTo 0 

' Wait for the program to finish. 
' Get the process handle. 
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id) 
If process_handle <> 0 Then 
WaitForSingleObject process_handle, INFINITE 
CloseHandle process_handle 
End If 

Exit Sub 

ShellError: 
MsgBox "Error starting task " & _ 
txtProgram.Text & vbCrLf & _ 
Err.Description, vbOKOnly Or vbExclamation, _ 
"Error" 

End Sub 

Sub ProcessData() 

    ShellAndWait (ThisWorkbook.Path & "\Datacleanup.exe") 

    Range("A2").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    With Selection 
     .HorizontalAlignment = xlLeft 
     .VerticalAlignment = xlTop 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
End Sub 

Answer 1

Shell機能の代わりにWshShell objectを試してください。

Dim wsh As Object 
Set wsh = VBA.CreateObject("WScript.Shell") 
Dim waitOnReturn As Boolean: waitOnReturn = True 
Dim windowStyle As Integer: windowStyle = 1 
Dim errorCode As Long 

errorCode = wsh.Run("notepad.exe", windowStyle, waitOnReturn) 

If errorCode = 0 Then 
    MsgBox "Done! No error to report." 
Else 
    MsgBox "Program exited with error code " & errorCode & "." 
End If  

こと

けれどもノート：bWaitOnReturnがfalse（デフォルト）に設定されている

場合は、Runメソッドが自動的に0を返し、プログラムを起動した後すぐに戻ります（エラーコードとして解釈してはなりません）。

プログラムが正常に実行されたかどうかを検出するには、上記の例のようにwaitOnReturnをTrueに設定する必要があります。それ以外の場合は、何があってもゼロを返します。事前バインディングについては

（自動補完へのアクセスを提供します）は、「Windowsスクリプトホストオブジェクトモデル」（ツール>リファレンス>設定のチェックマーク）への参照を設定し、次のように宣言します。あなたのプロセスを実行するために、今すぐ

Dim wsh As WshShell 
Set wsh = New WshShell 

メモ帳の代わりに...私はあなたのシステムがスペース文字（...\My Documents\...、...\Program Files\...、等を含むパスでbalkすることを期待する

Dim pth as String 
pth = """" & ThisWorkbook.Path & "\ProcessData.exe" & """" 
errorCode = wsh.Run(pth , windowStyle, waitOnReturn) 

Answer 2

を使用して、私の完全なコードは、私がTimer機能を使用することで、この時に来るでした。 .exeがそのことをやっている間にマクロを一時停止させたいと思ったら、コメント行の '10'を任意の時間（秒）に変更してください。

Strt = Timer 
Shell (ThisWorkbook.Path & "\ProcessData.exe") 
Do While Timer < Strt + 10  'This line loops the code for 10 seconds 
Loop 
UserForm2.Hide 

'Additional lines to set formatting 

これはすべきことですが、そうでない場合は教えてください。

Cheers、Ben。

Answer 3

あなたが行方不明

Private Const SYNCHRONIZE = &H100000 

を追加したら、あなたは動作します持っているもの：）、あなたは"引用符"でパスを囲む必要がありそう。

がで実証されたようにOption Explicitは、すべてのモジュールの一番上の行は、この場合には

Answer 4

WScript.Shellオブジェクトの.Run()メソッドをエラーを上げているだろう作る（0を意味することは有効ではありませんこれは右OpenProcessへのアクセスとして渡されています）呼び出すコマンドが予定された時間枠内で終了することがわかっている場合はJean-François Corbett's helpful answerが適切です。

以下はSyncShell()です。これは、ShellAndWait()の実装からインスピレーションを得て、タイムアウトを指定できる代替方法です。 （後者は少し重い利きで、時には無駄の代替であることが好ましい。）

' Windows API function declarations. 
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long 
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long 
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long 
Private Declare Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpExitCodeOut As Long) As Integer 

' Synchronously executes the specified command and returns its exit code. 
' Waits indefinitely for the command to finish, unless you pass a 
' timeout value in seconds for `timeoutInSecs`. 
Private Function SyncShell(ByVal cmd As String, _ 
          Optional ByVal windowStyle As VbAppWinStyle = vbMinimizedFocus, _ 
          Optional ByVal timeoutInSecs As Double = -1) As Long 

    Dim pid As Long ' PID (process ID) as returned by Shell(). 
    Dim h As Long ' Process handle 
    Dim sts As Long ' WinAPI return value 
    Dim timeoutMs As Long ' WINAPI timeout value 
    Dim exitCode As Long 

    ' Invoke the command (invariably asynchronously) and store the PID returned. 
    ' Note that this invocation may raise an error. 
    pid = Shell(cmd, windowStyle) 

    ' Translate the PIP into a process *handle* with the 
    ' SYNCHRONIZE and PROCESS_QUERY_LIMITED_INFORMATION access rights, 
    ' so we can wait for the process to terminate and query its exit code. 
    ' &H100000 == SYNCHRONIZE, &H1000 == PROCESS_QUERY_LIMITED_INFORMATION 
    h = OpenProcess(&H100000 Or &H1000, 0, pid) 
    If h = 0 Then 
     Err.Raise vbObjectError + 1024, , _ 
      "Failed to obtain process handle for process with ID " & pid & "." 
    End If 

    ' Now wait for the process to terminate. 
    If timeoutInSecs = -1 Then 
     timeoutMs = &HFFFF ' INFINITE 
    Else 
     timeoutMs = timeoutInSecs * 1000 
    End If 
    sts = WaitForSingleObject(h, timeoutMs) 
    If sts <> 0 Then 
     Err.Raise vbObjectError + 1025, , _ 
     "Waiting for process with ID " & pid & _ 
     " to terminate timed out, or an unexpected error occurred." 
    End If 

    ' Obtain the process's exit code. 
    sts = GetExitCodeProcess(h, exitCode) ' Return value is a BOOL: 1 for true, 0 for false 
    If sts <> 1 Then 
     Err.Raise vbObjectError + 1026, , _ 
      "Failed to obtain exit code for process ID " & pid & "." 
    End If 

    CloseHandle h 

    ' Return the exit code. 
    SyncShell = exitCode 

End Function 

' Example 
Sub Main() 

    Dim cmd As String 
    Dim exitCode As Long 

    cmd = "Notepad" 

    ' Synchronously invoke the command and wait 
    ' at most 5 seconds for it to terminate. 
    exitCode = SyncShell(cmd, vbNormalFocus, 5) 

    MsgBox "'" & cmd & "' finished with exit code " & exitCode & ".", vbInformation 


End Sub