Attendere Shell per finire, poi le cellule formato - in modo sincrono eseguire un comando

Question

Ho un eseguibile che io chiamo con il comando di shell:

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

L'eseguibile fa alcune calcoli, poi esporta i risultati torna Excel. Voglio poter modificare il formato dei risultati DOPO che vengono esportati.

In altre parole, ho bisogno del comando Shell prima di ATTENDERE fino a quando l'eseguibile termina il suo compito, esporta i dati e POI esegue i successivi comandi da formattare.

Ho provato il Shellandwait(), ma senza molta fortuna.

ho avuto:

Sub Test() 

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

'Additional lines to format cells as needed 

End Sub 

Purtroppo, ancora, la formattazione avviene prima le finiture eseguibili.

Solo per riferimento, qui era il mio codice completo utilizzando 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

Provare il WshShell object anziché la funzione nativa Shell.

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  

Anche se nota che:

Se bWaitOnReturn è impostato su false (impostazione predefinita), il metodo Run restituisce immediatamente dopo l'avvio del programma, ritornando automaticamente 0 (non devono essere interpretati come un codice di errore).

Quindi per rilevare se il programma è stato eseguito correttamente, è necessario impostare waitOnReturn su True come nell'esempio sopra riportato. Altrimenti restituirà zero a prescindere da cosa.

Per l'associazione anticipata (dà accesso a completamento automatico), impostare un riferimento a "Windows Script Host Object Model" (Strumenti> Riferimenti> segno di spunta set) e dichiarare come questo:

Dim wsh As WshShell 
Set wsh = New WshShell 

ora per eseguire il processo di invece di Notepad ... prevedo che il tuo sistema si bloccherà su percorsi contenenti caratteri spaziali (...\My Documents\..., ...\Program Files\..., ecc.), Così si dovrebbe racchiudere il percorso tra virgolette "":

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

Answer 2

sarei arrivato a questo utilizzando la funzione Timer. Calcola approssimativamente quanto a lungo desideri che la macro si interrompa mentre l'exe fa la sua cosa, e poi cambia il "10" nella riga commentata a qualsiasi ora (in secondi) che desideri.

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 

Questo dovrebbe fare il trucco, fammi sapere se non.

Cheers, Ben.

Answer 3

Quello che devi funzionerà una volta che si aggiungere

Private Const SYNCHRONIZE = &H100000 

cui il vostro mancanti. (Senso 0 viene passato come il diritto di accesso ai OpenProcess che non è valido)

Fare Option Explicit la linea superiore di tutti i moduli avrebbe sollevato un errore in questo caso

Answer 4

metodo dell'oggetto WScript.Shell.Run() come dimostrato Jean-François Corbett's helpful answer è la scelta giusta se sai che il comando che invochi finirà nel tempo previsto.

Di seguito è SyncShell(), un'alternativa che consente di specificare un timeout, ispirato al grande ShellAndWait() implementazione. (Quest'ultimo è un po 'pesante e talvolta un'alternativa più snella è preferibile.)

' 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