retval funcion from desde comando abrir vba shell synchronous

funcion - vba comando shell



Espere a que Shell finalice, luego formatee las celdas, ejecute un comando sincrónicamente (4)

El WScript.Shell .Run() del objeto .Run() , como se demostró en la útil respuesta de Jean-François Corbett, es la elección correcta si sabe que el comando que invoca finalizará en el tiempo previsto.

A continuación se muestra SyncShell() , una alternativa que le permite especificar un tiempo de espera , inspirado en la gran implementación de ShellAndWait() . (Este último es un poco torpe y, a veces, es preferible una alternativa más ligera).

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

Tengo un ejecutable al que llamo usando el comando de shell:

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

El ejecutable realiza algunos cálculos y luego exporta los resultados a Excel. Quiero poder cambiar el formato de los resultados DESPUÉS de que se exporten.

En otras palabras, necesito el comando de Shell primero para ESPERAR hasta que el ejecutable termine su tarea, exporte los datos, y luego haga los siguientes comandos para formatear.

Shellandwait() el Shellandwait() , pero sin mucha suerte.

Tuve:

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

Lamentablemente, aún así, el formateo tiene lugar primero antes de que finalice el ejecutable.

Solo como referencia, aquí estaba mi código completo usando 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


Lo que tienes funcionará una vez que agregas

Private Const SYNCHRONIZE = &H100000

cual tu falta (El significado 0 se pasa como el derecho de acceso a OpenProcess que no es válido)

Option Explicit hacer Option Explicit la línea superior de todos sus módulos habría provocado un error en este caso


Me gustaría llegar a esto mediante el uso de la función del Timer . Calcule aproximadamente cuánto tiempo desea que la macro se detenga mientras el .exe hace su trabajo, y luego cambie el ''10'' en la línea comentada a cualquier hora (en segundos) que desee.

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

Esto debería hacer el truco, hágamelo saber si no.

Saludos, Ben.


Pruebe el objeto WshShell en lugar de la función 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

Aunque tenga en cuenta que:

Si bWaitOnReturn se establece en falso (valor predeterminado), el método Run regresa inmediatamente después de iniciar el programa, devolviendo automáticamente 0 (no debe interpretarse como un código de error).

Entonces, para detectar si el programa se ejecutó exitosamente, necesita waitOnReturn para establecerse en True como en mi ejemplo anterior. De lo contrario, simplemente devolverá cero sin importar qué.

Para el enlace anticipado (da acceso a Autocompletar), establezca una referencia a "Windows Script Host Object Model" (Herramientas> Referencia> establecer marca de verificación) y declare de esta manera:

Dim wsh As WshShell Set wsh = New WshShell

Ahora, para ejecutar su proceso en lugar del Bloc de notas ... espero que su sistema se bloquee en las rutas que contienen caracteres espaciales ( .../My Documents/... , .../Program Files/... , etc.), por lo que debe adjuntar la ruta en " comillas " :

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