I am using VBA in my Access DB to launch a batch file which is linked to PS1 script.
That all works as intended. The issue is that I want to run some queries after that action is completed, but as it stands I need to babysit the whole thing. So I am looking for a solution to keep the VBA paused while the batch is running.
I found this article: https://danwagner.co/how-to-run-a-batch-file-and-wait-until-it-finishes-with-vba/
But the solution doesn't work for me for some reason. The batch runs, but the VBA just steams on ahead without pausing.
Here is my code:
Private Sub Button_UpdateOffline_Click()
Dim strCommand As String
Dim lngErrorCode As Long
Dim wsh As WshShell
Set wsh = New WshShell
DoCmd.OpenForm "Please_Wait"
'Run the batch file using the WshShell object
strCommand = Chr(34) & _
"C:\Users\Rip\Q_Update.bat" & _
Chr(34)
lngErrorCode = wsh.Run(strCommand, _
WindowStyle:=0, _
WaitOnReturn:=True)
If lngErrorCode <> 0 Then
MsgBox "Uh oh! Something went wrong with the batch file!"
Exit Sub
End If
DoCmd.Close acForm, "Please_Wait"
End Sub
Here is my batch code if that helps:
START PowerShell.exe -ExecutionPolicy Bypass -Command "& 'C:\Users\Rip\PS1\OfflineFAQ_Update.ps1' "
CodePudding user response：
Your batch code launches PowerShell, then closes.
VBA waits until your batch code has launched PowerShell, then continues. It has no way to know you actually want to wait until PowerShell has finished, since if you want to wait on that, you'd have to make your batch script wait as well.
So, either change the batch code to include /WAIT, in addition to the changes suggested in the comments:
START /wait PowerShell.exe -ExecutionPolicy Bypass -Command "& 'C:\Users\Rip\PS1\OfflineFAQ_Update.ps1' "
Or, open PowerShell directly without the batch file in between:
strCommand = "PowerShell.exe -ExecutionPolicy Bypass -Command ""& 'C:\Users\Rip\PS1\OfflineFAQ_Update.ps1' """
CodePudding user response：
Use the WaitForSingleObject API call. It takes a bit lengthy code, but is very simple to implement when wrapped in a function like ShellWait below.
This way, you can call the PowerShell command directly as in this example:
' Unblock a file or all files of a folder.
'
' 2022-10-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function UnblockFiles( _
ByVal Path As String) _
As Boolean
Const CommandMask As String = "PowerShell -command {0}"
Const ArgumentMask As String = "Dir ""{0}"" -Recurse | Unblock-File"
Const WindowStyle As Long = VbAppWinStyle.vbHide
Dim Argument As String
Dim Command As String
Dim Result As Long
Dim Success As Boolean
If Dir(Path, vbDirectory) = "" Then
' Path is neither a file nor a folder.
Else
' Continue.
Argument = Replace(ArgumentMask, "{0}", Path)
Command = Replace(CommandMask, "{0}", Argument)
Result = ShellWait(Command, WindowStyle)
Success = Not CBool(Result)
End If
UnblockFiles = Success
End Function
You'll see, that the command is assembled from the top two constants and a variable. You should be able to modify those for your command.
The ShellWait I use:
' General constants.
'
' Wait forever.
Private Const Infinite As Long = &HFFFF
' Process Security and Access Rights.
'
' The right to use the object for synchronization.
' This enables a thread to wait until the object is in the signaled state.
Private Const Synchronize As Long = &H100000
' Constants for WaitForSingleObject.
'
' The specified object is a mutex object that was not released by the thread
' that owned the mutex object before the owning thread terminated.
' Ownership of the mutex object is granted to the calling thread and the
' mutex state is set to nonsignaled.
Private Const StatusAbandonedWait0 As Long = &H80
Private Const WaitAbandoned As Long = StatusAbandonedWait0 0
' The state of the specified object is signaled.
Private Const StatusWait0 As Long = &H0
Private Const WaitObject0 As Long = StatusWait0 0
' The time-out interval elapsed, and the object's state is nonsignaled.
Private Const WaitTimeout As Long = &H102
' The function has failed. To get extended error information, call GetLastError.
Private Const WaitFailed As Long = &HFFFFFFFF
' Missing enum when using late binding.
'
#If EarlyBinding = False Then
Public Enum IOMode
ForAppending = 8
ForReading = 1
ForWriting = 2
End Enum
#End If
' API declarations.
' Opens an existing local process object.
' If the function succeeds, the return value is an open handle
' to the specified process.
' If the function fails, the return value is NULL (0).
' To get extended error information, call GetLastError.
'
#If VBA7 Then
Private Declare PtrSafe Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) _
As LongPtr
#Else
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) _
As Long
#End If
' The WaitForSingleObject function returns when one of the following occurs:
' - the specified object is in the signaled state.
' - the time-out interval elapses.
'
' The dwMilliseconds parameter specifies the time-out interval, in milliseconds.
' The function returns if the interval elapses, even if the object's state is
' nonsignaled.
' If dwMilliseconds is zero, the function tests the object's state and returns
' immediately.
' If dwMilliseconds is Infinite, the function's time-out interval never elapses.
'
#If VBA7 Then
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As LongPtr, _
ByVal dwMilliseconds As Long) _
As Long
#Else
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) _
As Long
#End If
' Closes an open object handle.
' If the function succeeds, the return value is nonzero.
' If the function fails, the return value is zero.
' To get extended error information, call GetLastError.
'
#If VBA7 Then
Private Declare PtrSafe Function CloseHandle Lib "kernel32" ( _
ByVal hObject As LongPtr) _
As Long
#Else
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) _
As Long
#End If
' Shells out to an external process and waits until the process ends.
' Returns 0 (zero) for no errors, or an error code.
'
' The call will wait for an infinite amount of time for the process to end.
' The process will seem frozen until the shelled process terminates. Thus,
' if the shelled process hangs, so will this.
'
' A better approach could be to wait a specific amount of time and, when the
' time-out interval expires, test the return value. If it is WaitTimeout, the
' process is still not signaled. Then either wait again or continue with the
' processing.
'
' Waiting for a DOS application is different, as the DOS window doesn't close
' when the application is done.
' To avoid this, prefix the application command called (shelled to) with:
' "command.com /c " or "cmd.exe /c ".
'
' For example:
' Command = "cmd.exe /c " & Command
' Result = ShellWait(Command)
'
' 2018-04-06. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function ShellWait( _
ByVal Command As String, _
Optional ByVal WindowStyle As VbAppWinStyle = vbNormalNoFocus) _
As Long
Const InheritHandle As Long = &H0
Const NoProcess As Long = 0
Const NoHandle As Long = 0
#If VBA7 Then
Dim ProcessHandle As LongPtr
#Else
Dim ProcessHandle As Long
#End If
Dim DesiredAccess As Long
Dim ProcessId As Long
Dim WaitTime As Long
Dim Closed As Boolean
Dim Result As Long
If Len(Trim(Command)) = 0 Then
' Nothing to do. Exit.
Else
ProcessId = Shell(Command, WindowStyle)
If ProcessId = NoProcess Then
' Process could not be started.
Else
' Get a handle to the shelled process.
DesiredAccess = Synchronize
ProcessHandle = OpenProcess(DesiredAccess, InheritHandle, ProcessId)
' Wait "forever".
WaitTime = Infinite
' If successful, wait for the application to end and close the handle.
If ProcessHandle = NoHandle Then
' Should not happen.
Else
' Process is running.
Result = WaitForSingleObject(ProcessHandle, WaitTime)
' Process ended.
Select Case Result
Case WaitObject0
' Success.
Case WaitAbandoned, WaitTimeout, WaitFailed
' Know error.
Case Else
' Other error.
End Select
' Close process.
Closed = CBool(CloseHandle(ProcessHandle))
If Result = WaitObject0 Then
' Return error if not closed.
Result = Not Closed
End If
End If
End If
End If
ShellWait = Result
End Function