等待Shell完成，然后格式化单元格 – 同步执行一个命令
我有一个使用shell命令调用的可执行文件：
Shell (ThisWorkbook.Path & "\ProcessData.exe") 可执行文件执行一些计算，然后将结果导出回Excel。 我希望能够在导出后更改结果的格式。
换句话说，我需要Shell命令首先等待，直到可执行文件完成其任务，导出数据，然后执行下一个命令进行格式化。
我尝试了Shellandwait() ，但没有多less运气。
我有：
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
尝试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
虽然注意到：
如果
bWaitOnReturn设置为false（缺省值），则Run方法在启动程序后立即返回，自动返回0（不能被解释为错误代码）。
因此，要检测程序是否成功执行，您需要将waitOnReturn设置为True，如上例所示。 否则无论如何它都会返回零。
对于早期绑定（提供对Autocompletion的访问），请设置对“Windows Script Host对象模型”（Tools> Reference> set checkmark）的引用，并声明如下：
Dim wsh As WshShell Set wsh = New WshShell
现在运行你的进程，而不是记事本…我期望你的系统将包含空格字符（ ...\My Documents\... ， ...\Program Files\...等path），所以你应该把path放在"引号" ：
Dim pth as String pth = """" & ThisWorkbook.Path & "\ProcessData.exe" & """" errorCode = wsh.Run(pth , windowStyle, waitOnReturn)
一旦你添加，你有什么工作
Private Const SYNCHRONIZE = &H100000
这是你的缺失。 （意思是0作为OpenProcess访问权限传递，无效）
制作Option Explicit在这种情况下， Option Explicit指出所有模块的第一行会产生错误
如果您知道您调用的命令将在预期的时间范围内完成，那么在Jean-FrançoisCorbett的有用答案中演示的WScript.Shell对象的.Run()方法是正确的select。
下面是SyncShell() ，一个允许您指定超时的备选scheme，由ShellAndWait()实现启发。 （后者有点笨手笨脚，有时更精简的select是可取的。）
' 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
我会通过使用Timerfunction来这个。 大概找出你需要多长时间才能让macros在.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
这应该做的伎俩，让我知道如果不是。
干杯，本。
