web-dev-qa-db-fra.com

Attendez que Shell se termine, puis formatez les cellules - exécutez une commande de manière synchrone

J'ai un exécutable que j'appelle en utilisant la commande Shell:

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

L'exécutable effectue des calculs, puis exporte les résultats vers Excel. Je veux pouvoir modifier le format des résultats APRÈS qu'ils soient exportés.

En d'autres termes, j'ai d'abord besoin de la commande Shell pour WAIT jusqu'à ce que l'exécutable termine sa tâche, exporte les données et ALORS exécute les commandes suivantes à formater.

J'ai essayé le Shellandwait(), mais sans beaucoup de chance.

J'ai eu:

Sub Test()

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

'Additional lines to format cells as needed

End Sub

Malheureusement, le formatage a lieu avant la fin de l’exécutable.

Juste pour référence, voici mon code complet en utilisant 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
vbashellsynchronous
29
Alaa Elwany

Essayez l'objet WshShell au lieu de la fonction native 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

Notez bien que:

Si bWaitOnReturn est défini sur false (valeur par défaut), la méthode Run revient immédiatement après le démarrage du programme, en renvoyant automatiquement 0 (ne doit pas être interprétée comme un code d'erreur).

Ainsi, pour détecter si le programme a été exécuté avec succès, vous devez définir waitOnReturn sur True, comme dans l'exemple ci-dessus. Sinon, il retournera zéro, quoi qu'il arrive.

Pour la liaison anticipée (donne accès à l'autocomplétion), définissez une référence à "Modèle d'objet hôte de script Windows" (Outils> Référence> cocher) et déclarez comme ceci:

Dim wsh As WshShell 
Set wsh = New WshShell

Maintenant, exécutez votre processus au lieu de Notepad ... Je suppose que votre système va reculer devant les chemins contenant des espaces (...\My Documents\..., ...\Program Files\..., etc.), vous devriez donc inclure le chemin dans "quotes":

Dim pth as String
pth = """" & ThisWorkbook.Path & "\ProcessData.exe" & """"
errorCode = wsh.Run(pth , windowStyle, waitOnReturn)
54
Jean-François Corbett

Ce que vous avez fonctionnera une fois que vous aurez ajouté

Private Const SYNCHRONIZE = &H100000

qui vous manque. (Signification 0 est passé en tant que droit d'accès à OpenProcess qui n'est pas valide)

Si Option Explicit était la première ligne de tous vos modules, une erreur s’est produite dans ce cas.

5
Alex K.

La méthode .Run() de l'objet WScript.Shell, comme indiqué dans La réponse utile de Jean-François Corbett est le bon choix si vous savez que la commande que vous appelez se terminera dans les délais prévus.

Ci-dessous figure SyncShell(), une alternative qui vous permet de spécifier un délai d’expiration, inspiré par la grande implémentation de ShellAndWait() . (Ce dernier est un peu lourd et parfois une alternative plus légère est préférable.)

' 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
2
mklement0

Shell-and-Wait dans VBA (Compact Edition)

Sub ShellAndWait(pathFile As String)
    With CreateObject("WScript.Shell")
        .Run pathFile, 1, True
    End With
End Sub

Exemple d'utilisation:

Sub demo_Wait()
    ShellAndWait ("notepad.exe")
    Beep 'this won't run until Notepad window is closed
    MsgBox "Done!"
End Sub

Adapté de (et d'autres options sur) Le site de Chip Pearson .

0
ashleedawg