Attendere il completamento di Shell, quindi formattare le celle – eseguire un comando in modo sincrono

Ho un eseguibile che chiamo usando il comando shell:

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

L’eseguibile esegue alcuni calcoli, quindi esporta i risultati su 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 esegui i prossimi comandi da formattare.

Ho provato Shellandwait() , ma senza molta fortuna.

Avevo:

 Sub Test() ShellandWait (ThisWorkbook.Path & "\ProcessData.exe") 'Additional lines to format cells as needed End Sub 

Sfortunatamente, ancora, la formattazione avviene prima che l’eseguibile termini.

Solo per riferimento, ecco il mio codice completo che utilizza 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 

Prova l’ object WshShell invece della funzione Shell nativa.

 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 

Sebbene noti che:

Se bWaitOnReturn è impostato su false (valore predefinito), il metodo Run ritorna immediatamente dopo l’avvio del programma, restituendo automaticamente 0 (non interpretabile come codice di errore).

Quindi, per rilevare se il programma è stato eseguito con successo, è necessario waitOnReturn per essere impostato su True come nel mio esempio sopra. Altrimenti restituirà zero a prescindere da cosa.

Per l’associazione anticipata (consente l’accesso al completamento automatico), impostare un riferimento a “Windows Script Host Object Model” (Strumenti> Riferimento> imposta segno di spunta) e dichiararlo in questo modo:

 Dim wsh As WshShell Set wsh = New WshShell 

Ora per eseguire il tuo processo al posto del blocco note … prevedo che il tuo sistema ritorcerà su percorsi contenenti caratteri spaziali ( ...\My Documents\... , ...\Program Files\... , ecc.), Quindi dovresti racchiudere il percorso tra " virgolette " :

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

Quello che hai funzionerà una volta aggiunto

 Private Const SYNCHRONIZE = &H100000 

quale ti manca. (Il significato 0 viene passato come diritto di accesso a OpenProcess che non è valido)

Rendere l’ Option Explicit la linea superiore di tutti i tuoi moduli avrebbe sollevato un errore in questo caso

Il metodo .Run() dell’object WScript.Shell , come dimostrato nella risposta utile di Jean-François Corbett, è la scelta giusta se si sa che il comando richiamato finirà nel tempo previsto.

Di seguito è riportato SyncShell() , un’alternativa che consente di specificare un timeout , ispirato ShellAndWait() . (Quest’ultimo è un po ‘pesante e a volte è preferibile un’alternativa più snella).

 ' 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 

Vorrei arrivare 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 no.

Saluti, Ben.