У меня есть исполняемый файл, который я вызываю с помощью команды оболочки:
Shell (ThisWorkbook.Path & "\ProcessData.exe")
Исполняемый файл выполняет некоторые вычисления, затем возвращает результаты в Excel. Я хочу, чтобы иметь возможность изменять формат результатов ПОСЛЕ экспорта.
Другими словами, мне сначала требуется команда Shell для WAIT, пока исполняемый файл не завершит свою задачу, не экспортирует данные, а THEN сделает следующие команды для форматирования.
Я попробовал 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 (по умолчанию), метод запуска возвращается сразу после запуска программы, автоматически возвращается 0 (не интерпретироваться как код ошибки).
Итак, чтобы определить, успешно ли выполнена программа, вам нужно waitOnReturn
установить значение True, как в моем примере выше. В противном случае он просто вернет нуль, несмотря ни на что.
Для раннего связывания (дает доступ к автозаполнению) установите ссылку на "Windows Script Модель объекта хоста" ( "Инструменты" > "Ссылка" > установите галочку) и объявите следующее:
Dim wsh As WshShell
Set wsh = New WshShell
Теперь для запуска вашего процесса вместо Notepad... Я ожидаю, что ваша система будет перекрывать пути, содержащие пробельные символы (...\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
верхняя строка всех ваших модулей вызовет ошибку в этом случае
Метод WScript.Shell
object .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 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
Я бы пришел к этому с помощью функции 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
Это должно сделать трюк, дайте мне знать, если нет.
Приветствия, Бен.
http://www.cpearson.com/excel/ShellAndWait.aspx