等待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

Answer 1

尝试使用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)

Answer 2

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

Private Const SYNCHRONIZE = &H100000

你失踪了.(意思0是作为OpenProcess无效的访问权限传递)

Option Explicit在这种情况下,制作所有模块的顶行会引发错误