vba 等待Shell完成，然后格式化单元格——同步执行一条命令

Wait for Shell to finish, then format cells - synchronously execute a command

提问by Alaa Elwany

I have an executable that I call using the shell command:

我有一个使用 shell 命令调用的可执行文件：

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

The executable does some computations, then exports results back to Excel. I want to be able to change the format of the results AFTER they are exported.

可执行文件进行一些计算，然后将结果导出回 Excel。我希望能够在导出结果后更改结果的格式。

In other words, i need the Shell command first to WAIT until the executable finishes its task, exports the data, and THEN do the next commands to format.

换句话说，我首先需要 Shell 命令等待，直到可执行文件完成其任务，导出数据，然后执行下一个命令进行格式化。

I tried the Shellandwait(), but without much luck.

我尝试了Shellandwait()，但运气不佳。

I had:

我有：

Sub Test()

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

'Additional lines to format cells as needed

End Sub

Unfortunately, still, formatting takes place first before the executable finishes.

不幸的是，在可执行文件完成之前，首先进行格式化。

Just for reference, here was my full code using ShellandWait

仅供参考，这是我使用 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

回答by Jean-Fran?ois Corbett

Try the WshShell objectinstead of the native Shellfunction.

尝试使用WshShell 对象而不是本机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    

Though note that:

虽然请注意：

If bWaitOnReturnis set to false (the default), the Run method returns immediately after starting the program, automatically returning 0 (not to be interpreted as an error code).

如果bWaitOnReturn设置为false（默认），Run方法在启动程序后立即返回，自动返回0（不被解释为错误代码）。

So to detect whether the program executed successfully, you need waitOnReturnto be set to True as in my example above. Otherwise it will just return zero no matter what.

所以要检测程序是否成功执行，你需要waitOnReturn像我上面的例子一样设置为 True 。否则无论如何它都会返回零。

For early binding (gives access to Autocompletion), set a reference to "Windows Script Host Object Model" (Tools > Reference > set checkmark) and declare like this:

对于早期绑定（允许访问自动完成），设置对“Windows 脚本宿主对象模型”的引用（工具 > 参考 > 设置复选标记）并声明如下：

Dim wsh As WshShell 
Set wsh = New WshShell

Now to run your process instead of Notepad... I expect your system will balk at paths containing space characters (...\My Documents\..., ...\Program Files\..., etc.), so you should enclose the path in "quotes":

现在运行的过程，而不是记事本......我期待你的系统将不惜包含空格字符（路径...\My Documents\...，...\Program Files\...等等），所以你应该在封闭的路径"报价"：

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

回答by Alex K.

What you have will work once you add

添加后您所拥有的将起作用

Private Const SYNCHRONIZE = &H100000

which your missing. (Meaning 0is being passed as the access right to OpenProcesswhich is not valid)

你失踪了。（意思0是作为OpenProcess无效的访问权限传递）

Making Option Explicitthe top line of all your modules would have raised an error in this case

使Option Explicit所有模块的顶行会在这种情况下，已经提出了一个错误

回答by mklement0

The WScript.Shellobject's .Run()method as demonstrated in Jean-Fran?ois Corbett's helpful answeris the right choice if you know that the command you invoke will finish in the expected time frame.

如果您知道调用的命令将在预期的时间范围内完成，那么在Jean-Fran?ois Corbett 的有用回答中演示的WScript.Shell对象.Run()方法是正确的选择。

Below is SyncShell(), an alternative that allows you to specify a timeout, inspired by the great ShellAndWait()implementation. (The latter is a bit heavy-handed and sometimes a leaner alternative is preferable.)

下面是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

回答by ashleedawg

Shell-and-Wait in VBA _{^{(Compact Edition)}}

VBA 中的 Shell-and-Wait _{^{（精简版）}}

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

---

---

Example Usage:

示例用法：

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

---

---

Adapted from (and more options at) Chip Pearson's site.

改编自（以及更多选项）Chip Pearson 的网站。

回答by foxtrott

I was looking for a simple solution too and finally ended up to make these two functions, so maybe for future enthusiast readers :)

我也在寻找一个简单的解决方案，最终完成了这两个功能，所以也许对于未来的发烧友读者:)

1.) prog must be running, reads tasklist from dos, output status to file, read file in vba

1.) prog 必须正在运行，从 dos 读取任务列表，输出状态到文件，在 vba 中读取文件

2.) start prog and wait till prog is closed with a wscript shell .exec waitonrun

2.) 启动 prog 并等待 prog 用 wscript shell .exec waitonrun 关闭

3.) ask for confirmation to delete tmp file

3.) 要求确认删除 tmp 文件

Modify program name and path variables and run in one go.

修改程序名和路径变量，一键运行。

Sub dosWOR_caller()

    Dim pwatch As String, ppath As String, pfull As String
    pwatch = "vlc.exe"                                      'process to watch, or process.exe (do NOT use on cmd.exe itself...)
    ppath = "C:\Program Files\VideoLAN\VLC"                 'path to the program, or ThisWorkbook.Path
    pfull = ppath & "\" & pwatch                            'extra quotes in cmd line

    Dim fout As String                                      'tmp file for r/w status in 1)
    fout = Environ("userprofile") & "\Desktop\dosWaitOnRun_log.txt"

    Dim status As Boolean, t As Double
    status = False

    '1) wait until done

    t = Timer
    If Not status Then Debug.Print "run prog first for this one! then close it to stop dosWORrun ": Shell (pfull)
    status = dosWORrun(pwatch, fout)
    If status Then Debug.Print "elapsed time: "; Format(Timer - t, "#.00s")

    '2) wait while running

    t = Timer
    Debug.Print "now running the prog and waiting you close it..."
    status = dosWORexec(pfull)
    If status = True Then Debug.Print "elapsed time: "; Format(Timer - t, "#.00s")

    '3) or if you need user action

    With CreateObject("wScript.Shell")
        .Run "cmd.exe /c title=.:The end:. & set /p""=Just press [enter] to delete tmp file"" & del " & fout & " & set/p""=and again to quit ;)""", 1, True
    End With

End Sub

Function dosWORrun(pwatch As String, fout As String) As Boolean
'redirect sdtout to file, then read status and loop

    Dim i As Long, scatch() As String

    dosWORrun = False

    If pwatch = "cmd.exe" Then Exit Function

    With CreateObject("wScript.Shell")
        Do
            i = i + 1

            .Run "cmd /c >""" & fout & """ (tasklist |find """ & pwatch & """ >nul && echo.""still running""|| echo.""done"")", 0, True

            scatch = fReadb(fout)

            Debug.Print i; scatch(0)

        Loop Until scatch(0) = """done"""
    End With

    dosWORrun = True
End Function

Function dosWORexec(pwatch As String) As Boolean
'the trick: with .exec method, use .stdout.readall of the WshlExec object to force vba to wait too!

    Dim scatch() As String, y As Object

    dosWORexec = False

    With CreateObject("wScript.Shell")

        Set y = .exec("cmd.exe /k """ & pwatch & """ & exit")

        scatch = Split(y.stdout.readall, vbNewLine)

        Debug.Print y.status
        Set y = Nothing
    End With

    dosWORexec = True
End Function

Function fReadb(txtfile As String) As String()
'fast read

    Dim ff As Long, data As String

    '~~. Open as txt File and read it in one go into memory
    ff = FreeFile
    Open txtfile For Binary As #ff
    data = Space$(LOF(1))
    Get #ff, , data
    Close #ff

    '~~> Store content in array
    fReadb = Split(data, vbCrLf)

    '~~ skip last crlf
    If UBound(fReadb) <> -1 Then ReDim Preserve fReadb(0 To UBound(fReadb) - 1)
End Function

回答by Muhammad Ali

Simpler and Compressed Code with examples:

带有示例的更简单和压缩的代码：

first declare your path

首先声明你的路径

Dim path: path = ThisWorkbook.Path & "\ProcessData.exe"

And then use any one line of following code you like


1) Shown + waited + exited

然后使用您喜欢的任何一行以下代码


1) 显示 + 等待 + 退出

VBA.CreateObject("WScript.Shell").Run path,1, True 

2) Hidden + waited + exited

2）隐藏+等待+退出

VBA.CreateObject("WScript.Shell").Run path,0, True

3) Shown + No waited

3) 显示 + 无需等待

VBA.CreateObject("WScript.Shell").Run path,1, False

4) Hidden + No waited

4) 隐藏 + 无需等待

VBA.CreateObject("WScript.Shell").Run path,0, False

回答by Ben F

I would come at this by using the Timerfunction. Figure out roughly how long you'd like the macro to pause while the .exe does its thing, and then change the '10' in the commented line to whatever time (in seconds) that you'd like.

我会通过使用该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

This should do the trick, let me know if not.

这应该可以解决问题，如果没有，请告诉我。

Cheers, Ben.

干杯，本。