Vba 等待Shell完成，然后格式化单元格-同步执行命令

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

”启动指定的程序并等待
“结束，在我们等待的时候躲起来。
私有声明函数CloseHandle Lib“kernel32.dll”（ByVal hObject作为Long）作为Long
私有声明函数WaitForSingleObject Lib“kernel32.dll”（ByVal hHandle长，ByVal DW毫秒长）长
私有声明函数OpenProcess Lib“kernel32.dll”（ByVal dwdesiredAccess为Long，ByVal bInheritHandle为Long，ByVal dwProcId为Long）为Long
私有常量无限=&HFFFF
私有子ShellAndWait（ByVal程序名称为字符串）
Dim进程\u id尽可能长
变暗处理（如长）
"启动程序。
关于错误转到ShellError
进程\u id=Shell（程序\u名称）
错误转到0
'等待程序完成。
'获取进程句柄。
进程\u句柄=OpenProcess（同步，0，进程\u id）
如果进程处理0，则
WaitForSingleObject进程\ U句柄，无限
CloseHandle进程\u句柄
如果结束
出口接头
外壳错误：
MsgBox“启动任务时出错”&_
txtProgram.Text&vbCrLf&_
错误说明，vbOKOnly或VBEQUOTION_
“错误”
端接头
子进程数据（）
ShellAndWait（ThisWorkbook.Path&“\Datacleanup.exe”）
范围（“A2”）。选择
范围（选择，选择。结束（xlToRight））。选择
范围（选择，选择。结束（xlDown））。选择
有选择
.HorizontalAlignment=xlLeft
.垂直对齐=xlTop
.WrapText=True
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
Selection.Borders（xlDiagonalDown）.LineStyle=xlNone
Selection.Borders（xlDiagonalUp）.LineStyle=xlNone
端接头

我会通过使用

定时器来实现这一点。大致计算出当.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

Strt=计时器
Shell（this工作簿.Path&“\ProcessData.exe”）
当定时器

这应该能奏效，如果不行，请告诉我

干杯，本。
尝试使用而不是本机的
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    

但请注意：

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

因此，要检测程序是否成功执行，需要将
waitOnReturn
设置为True，如上面的示例所示。否则，不管发生什么，它都将返回零

对于早期绑定（允许访问自动完成），请将引用设置为“Windows脚本主机对象模型”（工具>引用>设置复选标记），并按如下方式声明：

Dim wsh As WshShell 
Set wsh = New WshShell

现在运行您的进程而不是记事本。。。我希望您的系统会阻止包含空格字符的路径（
..\My Documents\..
，
..\Program Files\..
等），因此您应该将路径括在
“
引号
”
中：

你所拥有的将在你添加后生效

Private Const SYNCHRONIZE = &H100000

这是你的失踪。（意味着
0
被传递为
OpenProcess
的访问权限，该权限无效）

如果您知道调用的命令将在预期的时间范围内完成，那么将
选项显式设置为所有模块的顶行将在这种情况下引发错误WScript.Shell
对象的
.Run（）
方法（如中所示）是正确的选择

下面是
SyncShell（）
，这是一种可以指定超时的替代方法，它的灵感来自伟大的实现。（后者有点笨手笨脚，有时更精简的替代方案更可取。）

Windows API函数声明。
私有声明函数OpenProcess Lib“kernel32.dll”（ByVal dwdesiredAccess为Long，ByVal bInheritHandle为Long，ByVal dwProcId为Long）为Long
私有声明函数CloseHandle Lib“kernel32.dll”（ByVal hObject作为Long）作为Long
私有声明函数WaitForSingleObject Lib“kernel32.dll”（ByVal hHandle长，ByVal DW毫秒长）长
将私有函数GetExitCodeProcess Lib“kernel32.dll”（ByVal hProcess作为Long，ByRef lpExitCodeOut作为Long）声明为整数
'同步执行指定的命令并返回其退出代码。
'无限期地等待命令完成，除非您传递
'timeoutInSecs'的超时值（秒）。
专用函数SyncShell（ByVal cmd作为字符串_
可选的ByVal窗口样式为VbAppWinStyle=vbMinimizedFocus_
可选的ByVal timeoutInSecs作为Double=-1）长度
将pid设置为Shell（）返回的长pid（进程ID）。
将h调暗为“长”工艺手柄
将sts设置为“Long”WinAPI返回值
Dim timeoutMs作为“长”WINAPI超时值
将退出代码变长
'调用命令（始终异步）并存储返回的PID。
'请注意，此调用可能会引发错误。
pid=Shell（cmd，windowStyle）
'使用
'同步和处理\u查询\u有限公司
Private Const SYNCHRONIZE = &H100000

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


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



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

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

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

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

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