1

When used on a 32 bit machine, waitforsingleobject works as expected and waits until process execution is completed. I am using it for running a batch file which runs a node js command. But when I used this code on 64 bit machine the batch file appears as launched (command window flickers and goes away) but it does not wait for its execution to get completed. I am using Excel from Office 365. Here is the code snippet I have used in VBA for it. This function receives batch file name as input:

Public Sub ExecCmd(cmdline As String)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ReturnValue As Integer

' Initialize the STARTUPINFO structure:
start.cb = Len(start)

' Start the shelled application:
ReturnValue = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

' Wait for the shelled application to finish:
Do
ReturnValue = WaitForSingleObject(proc.hProcess, 0)
DoEvents
Loop Until ReturnValue <> 258

ReturnValue = CloseHandle(proc.hProcess)
End Sub

And, here is the declaration for using APIs.

Public Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal _
    hHandle As Long, ByVal dwMilliseconds As Long) As Long
    
    Public Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _
    lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
    lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As STARTUPINFO, lpProcessInformation As _
    PROCESS_INFORMATION) As Long
    
    Public Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _
    hObject As Long) As Long

Can you please assist me in fixing this? Any help is highly appreciable.

Thanks in advance.

Jaqen H'ghar
  • 1,839
  • 7
  • 37
  • 66
  • Your `Declare`s are [all wrong](https://stackoverflow.com/a/63801528/11683), but it would appear you simply want https://stackoverflow.com/a/15952009/11683? – GSerg Jun 18 '21 at 11:20
  • All handles/pointers should be declared as `LongPtr` for 64 bit. – Rory Jun 18 '21 at 11:20

2 Answers2

4

Should look something like below. This should work in 32 bit and 64 bit.

Option Explicit

#If Win64 And VBA7 Then
    'some of these declaration get red in VBA6 (no worries)
    
    Private Type STARTUPINFO       ' x86, Win64
        cb              As Long    '   4      4
        padding1        As Long
        lpReserved      As String  '   4      8
        lpDesktop       As String  '   4      8
        lpTitle         As String  '   4      8
        dwX             As Long    '   4      4
        dwY             As Long    '   4      4
        dwXSize         As Long    '   4      4
        dwYSize         As Long    '   4      4
        dwXCountChars   As Long    '   4      4
        dwYCountChars   As Long    '   4      4
        dwFillAttribute As Long    '   4      4
        dwFlags         As Long    '   4      4
        wShowWindow     As Integer '   2      2
        cbReserved2     As Integer '   2      2
        padding2        As Long
        lpReserved2     As LongPtr '   4      8
        hStdInput       As LongPtr '   4      8
        hStdOutput      As LongPtr '   4      8
        hStdError       As LongPtr '   4      8
    End Type                   ' Sum: 68     96
    
    Private Type SECURITY_ATTRIBUTES
        nLength              As Long
        padding1             As Long
        lpSecurityDescriptor As LongPtr
        bInheritHandle       As Long
    End Type
    
    Private Type PROCESS_INFORMATION
        hProcess    As LongPtr
        hThread     As LongPtr
        dwProcessID As Long
        dwThreadID  As Long
    End Type
        
    Private Declare PtrSafe Function CreateProcess Lib "Kernel32" Alias "CreateProcessA" ( _
        ByVal lpAppName As String, ByVal lpCmdLine As String, lpProcAttr As Any, _
        lpThreadAttr As Any, ByVal lpInheritedHandle As Long, ByVal lpCreationFlags As Long, _
        ByVal lpEnv As Any, ByVal lpCurDir As String, lpStartupInfo As STARTUPINFO, _
        lpProcessInfo As PROCESS_INFORMATION) As LongPtr
        
    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
        
#Else
    'some of these declaration get red in VBA7 (no worries)
    Private Declare Function CreateProcess Lib "Kernel32" Alias _
                                                "CreateProcessA" ( _
        ByVal lpAppName As Long, _
        ByVal lpCmdLine As String, _
        ByVal lpProcAttr As Long, _
        ByVal lpThreadAttr As Long, _
        ByVal lpInheritedHandle As Long, _
        ByVal lpCreationFlags As Long, _
        ByVal lpEnv As Long, _
        ByVal lpCurDir As Long, _
        lpStartupInfo As STARTUPINFO, _
        lpProcessInfo As PROCESS_INFORMATION _
        ) As Long
    
    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
        
    'Einige Datentypen erstellen
    Private Type STARTUPINFO
        cb              As Long
        lpReserved      As String
        lpDesktop       As String
        lpTitle         As String
        dwX             As Long
        dwY             As Long
        dwXSize         As Long
        dwYSize         As Long
        dwXCountChars   As Long
        dwYCountChars   As Long
        dwFillAttribute As Long
        dwFlags         As Long
        wShowWindow     As Integer
        cbReserved2     As Integer
        lpReserved2     As Long
        hStdInput       As Long
        hStdOutput      As Long
        hStdError       As Long
    End Type
    
    Private Type SECURITY_ATTRIBUTES
        nLength              As Long
        lpSecurityDescriptor As Long
        bInheritHandle       As Long
    End Type
    
    Private Type PROCESS_INFORMATION
        hProcess    As Long
        hThread     As Long
        dwProcessID As Long
        dwThreadID  As Long
    End Type
#End If


Public Sub ExecCmd(ByVal cmdline As String)
    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    
    #If Win64 And VBA7 Then
        Dim ReturnValueProcess As LongPtr
    #Else
        Dim ReturnValueProcess As Long
    #End If
    
    ' Initialize the STARTUPINFO structure:
    start.cb = Len(start)
    
    ' Start the shelled application:
    ReturnValueProcess = CreateProcessA(0&, cmdline, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    
    ' Wait for the shelled application to finish:
    Dim ReturnValue As Long
    Do
        ReturnValue = WaitForSingleObject(proc.hProcess, 0)
        DoEvents
    Loop Until ReturnValue <> 258
    
    ReturnValue = CloseHandle(proc.hProcess)
End Sub
Tragamor
  • 3,594
  • 3
  • 15
  • 32
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • 1
    Did you check for any [additional x64 padding](https://stackoverflow.com/a/66736433/11683)? – GSerg Jun 18 '21 at 13:02
  • @GSerg Nope, didn't check it. – Pᴇʜ Jun 18 '21 at 13:15
  • For `STARTUPINFO` there is 4 bytes before `lpReserved` and 4 bytes before `lpReserved2`. For `SECURITY_ATTRIBUTES` there is 4 bytes before `lpSecurityDescriptor`. `PROCESS_INFORMATION` is fine. – GSerg Jun 18 '21 at 13:42
  • @GSerg I edited it. Thank's for checking. Is there an easy way to find out which need padding? – Pᴇʜ Jun 18 '21 at 13:47
  • 1
    For some definitions of "easy". Create an empty C++ project and make it output all the `offsetof(STARTUPINFO, lpReserved)`, then compare with the naive count. – GSerg Jun 18 '21 at 13:52
  • 2
    Rather than having duplicate Type declarations, can you have one declaration with `#IF WIN64... #End If` segments within the Type? Not sure if readability for this would be compromised though – Tragamor Jun 18 '21 at 15:41
  • @Tragamor Of course you can do that. Just a coding style decision. – Pᴇʜ Jun 18 '21 at 16:00
  • The above code does not compile in my 64 bit Access 2021. – Chris Good Dec 06 '22 at 07:27
  • The call to CreateProcessA in ExecCmd gets: Compile error: Sub or Function not defined. I copied and pasted the code from above and I don't think there are any problems with weird double quote characters... Any help would be much appreciated. – Chris Good Dec 06 '22 at 07:34
-1

The following code has served the purpose for which I posted this question here. I thought to share it for any future reference. I got this solution from a forum thread here

Option Explicit

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess _
    As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
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 Sub ShellAndWait(ByVal program_name As String, _
                         Optional ByVal window_style As VbAppWinStyle = vbNormalFocus, _
                         Optional ByVal max_wait_seconds As Long = 0)
Dim lngProcessId As Long
Dim lngProcessHandle As Long
Dim datStartTime As Date
Const WAIT_TIMEOUT = &H102
Const SYNCHRONIZE As Long = &H100000
Const INFINITE As Long = &HFFFFFFFF

    ' Start the program.
    On Error GoTo ShellError
    lngProcessId = Shell(program_name, window_style)
    On Error GoTo 0
    
    DoEvents

    ' Wait for the program to finish.
    ' Get the process handle.
    lngProcessHandle = OpenProcess(SYNCHRONIZE, 0, lngProcessId)
    If lngProcessHandle <> 0 Then
        datStartTime = Now
        Do
          If WaitForSingleObject(lngProcessHandle, 250) <> WAIT_TIMEOUT Then
            Exit Do
          End If
          DoEvents
          If max_wait_seconds > 0 Then
            If DateDiff("s", datStartTime, Now) > max_wait_seconds Then Exit Do
          End If
        Loop
        CloseHandle lngProcessHandle
    End If
    Exit Sub
    
ShellError:
End Sub
Jaqen H'ghar
  • 1,839
  • 7
  • 37
  • 66
  • I don't see how this could have helped you if the point of your question is being compatible with 64-bit. This code is not. – GSerg Jun 22 '21 at 10:38
  • My earlier code was working on a 32 bit machine. It used to wait for batch file execution synchronously, before executing next code block. The above posted code is different but achieves synchronous execution, thought I too wonder it need not require changing Long to 'LongPtr'. I am yet to figure that out. – Jaqen H'ghar Jun 22 '21 at 11:43