等待Shell执行完毕后，再格式化单元格 - 同步执行命令。

Question

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

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

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

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

我尝试了 Shellandwait()，但没有太多成功。

我写的是：

Sub Test()

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

'Additional lines to format cells as needed

End Sub

不幸的是，在可执行程序完成之前，格式化仍然会首先发生。

只是作为参考，这是我使用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

- Alaa Elwany

---

如果您想在“http://www.cpearson.com/excel/ShellAndWait.aspx”上尝试完整代码。 - lovechillcool

Answer 1

不要使用原生的Shell函数，而是尝试使用WshShell对象。

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    

需要注意的是:

如果未设置bWaitOnReturn为true（默认值为false），则Run方法会在启动程序后立即返回，自动返回0（不要将其解释为错误代码）。

因此，要检测程序是否成功执行，您需要将waitOnReturn设置为True，就像我上面的示例一样。否则，无论如何它都将返回零。

对于早期绑定（提供自动完成功能），请引用“Windows Script Host Object Model”(工具> 引用>设置复选框)，并像以下这样声明:

Dim wsh As WshShell 
Set wsh = New WshShell

现在，要运行您的进程而不是记事本......我预计您的系统将拒绝包含空格字符的路径（...\我的文档\...，...\程序文件\...等），因此您应该用"引号"将路径括起来：

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

- Jean-François Corbett

---

这个可以工作，但是当进程被封装成一个可执行文件时，如果需要用户登录或执行其他任务，则会失败。 - John Shaw

有趣...它到底是怎么失败的？ - Jean-François Corbett

听起来你正在调用一个可执行文件，这个可执行文件又调用了另一个可执行文件，而原始的可执行文件的进程在后者之前退出。在这种情况下，你必须编写一个包装脚本，它会进行自己的等待，并从wsh.Run()中调用该包装脚本。 - mklement0

@mklement0 - 是的。这就是后来我发现的情况。谢谢你。我很欣赏你的远见和经验...那正是问题所在。 - John Shaw

Answer 2

只要添加所需的内容，你所拥有的就可以发挥作用。

Private Const SYNCHRONIZE = &H100000

你缺少的是权限。这意味着将 0 作为访问权限传递给 OpenProcess 是无效的。

在所有模块的顶部加上 Option Explicit 将会在这种情况下引发错误。

- Alex K.

---

谢谢，但是当我尝试这个时，宏因某种原因一直循环！ :-( 我做错了什么，但是想不出来。也许使用WshShell也是一个好选择。 - Alaa Elwany

Answer 3

在VBA中使用Shell和Wait _^(精简版)

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

使用示例：

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

---

该内容来自（更多选项在）Chip Pearson的网站。

- ashleedawg

Answer 4

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

下面是一个名为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

- mklement0

Answer 5

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

首先声明您的路径。

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

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


1）显示 + 等待 + 退出

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

"2) 隐藏 + 等待 + 退出"

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

3) 显示 + 无等待

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

4) 隐藏 + 不等待

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

- Sorry IwontTell

Answer 6

我也在寻找一个简单的解决方案，最终我做了这两个函数，或许对未来的爱好者有帮助 :)

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

2.) 启动程序并等待wscript shell .exec waitonrun关闭程序

3.) 请求确认以删除tmp文件

修改程序名称和路径变量并一次性运行。

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

- foxtrott

Answer 7

我将它加入了一个例程中，过去几年来一直运行良好（但并未经常使用）- 非常感谢！

但是现在我发现它出现了一个错误：-

运行时错误' - 2147024894（80070002）'：

对象 'IWshSheB' 的方法“Run”失败。

出错的代码行是：

ErrorCode = wsh.Run(myCommand, windowStyle, WaitOnReturn)

非常奇怪！

---

5个小时后！

我认为它失败的原因是，亲爱的微软（“亲爱的”意思是昂贵的）已经做了一些根本性的改变 - “Shell”曾经是“Shell to DOS”，但是否已经改变？我想要Shell运行的“命令”只是DIR。完整的命令是“DIR C：\ Folder \ / S> myFIle.txt”

..........................

一个小时后-

是的！ 我通过使用这段代码解决了它，它完全正常：

    Sub ShellAndWait(PathFile As String, _
                     Optional Wait As Boolean = True, _
                     Optional Hidden As Boolean = True)
    ' Hidden = 0; Shown = 1
    Dim Hash As Integer, myBat As String, Shown As Integer
    Shown = 0
    If Hidden Then Shown = 1
    If Hidden <> 0 Then Hidden = 1
    Hash = FreeFile
    
    myBat = "C:\Users\Public\myBat.bat"
    
    Open myBat For Output As #Hash
    Print #Hash, PathFile
    Close #Hash
    
        With CreateObject("WScript.Shell")
            .Run myBat, Shown, Wait
        End With
    End Sub

- RobinClay

Answer 8

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

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

谢谢，Ben。

- Ben F

---

如果进程运行时间超出预期，这个过程每次都会失败。可能由于各种原因导致，比如磁盘备份正在进行。 - Jean-François Corbett

谢谢Ben。问题是有时可执行文件可能需要5秒钟，有时需要10分钟。我不想为它设置一个“恒定”的计时器，而是要等待它完成。但是你的建议对我的代码中的其他地方很有用。非常感谢！ - Alaa Elwany

使用计时器几乎总是最糟糕的选择。 - JDuarteDJ