我有一个使用shell命令调用的可执行文件：
Shell (ThisWorkbook.Path & "ProcessData.exe")
可执行文件进行一些计算，然后将结果导出回Excel。我希望能够在导出结果后更改结果的格式。
换句话说，我首先需要Shell命令WAIT，直到可执行文件完成任务，导出数据，然后执行下一个命令进行格式化。
我试过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
尝试使用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，就像我上面的例子一样。否则，不管怎样，它都将返回零。
对于早期绑定（允许访问自动完成），请设置对"Windows脚本主机对象模型"的引用（工具>引用>设置复选标记），并如下声明：
Dim wsh As WshShell
Set wsh = New WshShell
现在要运行进程而不是记事本。。。我预计您的系统会对包含空格字符的路径（...My Documents...、...Program Files...等）感到犹豫，所以您应该将路径包含在"引号中":
Dim pth as String
pth = """" & ThisWorkbook.Path & "ProcessData.exe" & """"
errorCode = wsh.Run(pth , windowStyle, waitOnReturn)
一旦添加，您所拥有的将起作用
Private Const SYNCHRONIZE = &H100000
你错过了什么。（意味着0作为OpenProcess的访问权限被传递，这是无效的）
在这种情况下，如果将Option Explicit设置为所有模块的顶行，则会引发错误
VBA中的外壳和等待（Compact Edition）
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的网站。
如果您知道您调用的命令将在预期的时间范围内完成，那么如Jean-François Corbett的有用答案中所示的WScript.Shell对象的.Run()方法是正确的选择。
下面是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
更简单和压缩的代码，示例：
首先声明您的路径
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
我也在寻找一个简单的解决方案，最终实现了这两个功能，所以对于未来的爱好者读者来说：）
1.）prog必须正在运行，从dos读取任务列表，将状态输出到文件，读取vba 中的文件
2.）启动prog并等待，直到使用wscript shell关闭prog。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 FilesVideoLANVLC" '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") & "DesktopdosWaitOnRun_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
我将其纳入了一个例程，几年来它一直运行良好（但不经常使用），非常感谢！
但现在我发现它抛出了一个错误：-运行时错误"-2147024894（80070002）"：对象"IWshSheB"的方法"Run"失败
在线-错误代码=wsh。运行（myCommand，windowStyle，WaitOnReturn）
很奇怪！
5小时后！
我认为它失败的原因是亲爱的MicroSoft（"亲爱的"的意思是昂贵的）改变了一些激进的东西；Shell"；过去是"；Shell到DOS"；，但这已经改变了吗？"；命令"；我希望Shell运行的只是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:UsersPublicmyBat.bat"
Open myBat For Output As #Hash
Print #Hash, PathFile
Close #Hash
With CreateObject("WScript.Shell")
.Run myBat, Shown, Wait
End With
End Sub
我会使用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
这应该会奏效，如果不行，请告诉我。
干杯，本。