Access, WaitShell not finishing before rest of code runs

Integrate

Registered User.
Local time
Tomorrow, 03:22
Joined
Oct 20, 2013
Messages
27
I am clearly missing something in my code but it seems to one of the many options I have tried that vaguely works.

My client added a Shell function to open an excel file that updates from some other software. But the file was taking too long to finish even with a pause and wasn't updating the linked table in access. It was also causing the database to freeze.

So I tried a WaitShell code I found in some forums so it wouldn't return until shell had executed, but it is still executing while the rest of the code runs. ie. A form is not meant to open until after the table is updated but it is opening before excel even opens.

How can I stop the sub from continuing until the Shell has finished? Or am I on completely the wrong track?

This is the WaitShell Function
Code:
Option Compare Database

Option Explicit
'Declare Function GetModuleUsage% Lib "Kernel32" (ByVal hModule%)
Function WaitShell(AppName As String)
Dim hMod As Integer
hMod = Shell(AppName, 1)
If (Abs(hMod) > 32) Then
'While (GetModuleUsage(hMod))
    DoEvents
    'Wend
    Else: MsgBox "Unable to Start" & AppName
    End If
    
End Function

This holds the file path:
Code:
Function RunWaitshell()
x = WaitShell("C:\Users\nptablet.AICAAP\Documents\Update DeltaV Excel tablet.bat")

End Function

This is the code I call it in:
Code:
Private Sub cmdPlantUtilities_Click()

If IsNull(cboStaff) Or cboStaff = "" Then
MsgBox "You must select a Staff Name", vbOKOnly, "STOP"
Me.cboStaff.SetFocus
Exit Sub
End If

Call Ping

Call RunWaitshell

DoCmd.SetWarnings (warningsoff)
Me.[txtDate] = Date
Me.txtTime = Time()
Me.txtLog = 4

DoCmd.RunSQL "INSERT INTO tbl_logdata ( log_ID, Log_Date, Log_Time, Staff_Initials, tag, unit, Sequence, Log_Route, Print_Route, Input_Value ) " & _
"SELECT [Forms]![frm_menu]![txtLog_ID] AS LogID, " & _
"[Forms]![frm_menu]![txtDate] AS Log_Date, [Forms]![frm_menu]![txtTime] AS Log_Time, " & _
"[Forms]![frm_menu]![cboStaff] AS Staff_Initials, tbl_plantutilities_sequence.tag, tbl_tags.unit,tbl_plantutilities_sequence.Sequence, " & _
"Format([Forms]![frm_menu]![txtLog],'#') AS Log_Route, tbl_tags.Print_Route, [tbl_DeltaV].[value for access database] AS DeltaV " & _
"FROM (tbl_tags INNER JOIN tbl_plantutilities_sequence ON tbl_tags.tag = tbl_plantutilities_sequence.tag) " & _
"LEFT JOIN tbl_DeltaV ON tbl_tags.tag = tbl_DeltaV.tag " & _
"WHERE (((tbl_plantutilities_sequence.Tag_Removed)=False)) " & _
"ORDER BY tbl_plantutilities_sequence.Sequence ASC"

DoCmd.OpenForm "frm_data_input_plantutilitieslog", acNormal, , "Log_ID = '" & Me.txtLog_ID & "'", , acWindowNormal

End Sub
 
Code:
#If Win64 Then

Private Declare PtrSafe Function  WaitForSingleObject Lib "kernel32" (ByVal hHandle As LongPtr, ByVal  dwMilliseconds As Long) As Long

Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long


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 WaitForSingleObject Lib "kernel32" (ByVal _
  hHandle As Long, ByVal dwMilliseconds As Long) As Long


Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject 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
#End If

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&


Public Sub ShellAndWait(ByVal program_name As String)
    Dim process_id As Long
#If Win64 Then
    Dim process_handle As LongPtr
#Else
    Dim process_handle As Long
#End If
    Const SYNCHRONIZE = &H100000

    ' 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 " & vbCrLf & _
    Err.Description, vbOKOnly Or vbExclamation, _
    "Error"
   
End Sub
 
Thanks a lot for the replies. I have used JHB's suggestion which seems to be working great.
I thought I had searched everywhere but seems my google missed the obvious.
Really appreciate your time :)
 

Users who are viewing this thread

Back
Top Bottom