Shell and Wait - 32 bit and 64 bit

[Aflatoon]

I see the problem. The code should read either:

#If VBA7 = 1 Then

or:

#If VBA7 Then

or even:

#If CBool(VBA7) = True Then

but not:

#If VBA7 = True Then

[ronjon65]

Thanks, after I made that adjustment, I got a "type mismatch" compile error. However, if also adjust the 64bit code to not have "LongPtr" (only Long) then it seems to work on both 32 bit and 64 bit (as follows). Is this OK?

#If VBA7 Then
     ' 64 Bit API
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
#Else
     
     ' 32 bit API
    Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
#End If

[Leith Ross]

Hello ronjon65,

VBA has the capability to load Modules into the VBProject. This can be done either by storing the code on worksheets that are hidden or by saving the code in Notepad files.

I have found a way to determine the whether the OS is 32 or 64 bit and if 32 bit files are supported on a 64 bit platform. The macro below will tell you. without using the API.

Currently, I am writing code to use this test and read files into the VB Project.

Sub OSInfo()

  ' Written:    January 07. 2016
  ' Author:     Leith Ross
  
    Dim colOperatingSystems As Object
    Dim Folder32            As Object
    Dim msg                 As String
    Dim objOS               As Object
    Dim strComputer         As String
    
        With CreateObject("Shell.Application")
            Set Folder32 = .Namespace(Environ("HOMEDRIVE") & "\Program Files (x86)")
        End With
        
        strComputer = "."
        
        Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
        
        For Each objOS In colOperatingSystems
            With objOS
                msg = .Caption & "  " & .Version & vbLf & .OSArchitecture
                If Not Folder32 Is Nothing And .OSArchitecture = "64-bit" Then
                    msg = msg & vbLf & "32 bit Programs are supported"
                End If
            End With
            MsgBox msg
        Next objOS

End Sub

[ronjon65]

Leith, that is interesting and might be useful.

Let me ask you this though. Once I modified the code from post #4 to the code in post #22, it seems to work at intended. Do you see any problems with code in #22? I shortened the LongPtr to Long and Aflatoon showed how to adjust the IF statement. This is a simple approach, but not sure how stable it is (did I make an incorrect mod)?

[Leith Ross]

Hello ronjon65,

The attached workbook will create or update the VBA module "API_Calls" from the 2 worksheets "32-bit API" and "64-bit API". "Sheet1" has instructions and the button to run the macro.

Here is the code for Module1.

Sub LoadAPICalls()

  ' Written:    January 07. 2016
  ' Author:     Leith Ross
  
    Dim BitSize             As String
    Dim colOperatingSystems As Object
    Dim Folder32            As Object
    Dim objOS               As Object
    Dim strComputer         As String
    
        With CreateObject("Shell.Application")
            Set Folder32 = .Namespace(Environ("HOMEDRIVE") & "\Program Files (x86)")
        End With
        
        strComputer = "."
        
        Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
        
        For Each objOS In colOperatingSystems
            With objOS
                BitSize = .OSArchitecture
                
                If BitSize = "32-bit" Then
                    CreateUpdateAPIModule BitSize
                    Exit Sub
                End If
                
                If Not Folder32 Is Nothing And BitSize = "64-bit" Then
                    CreateUpdateAPIModule "32-bit"
                    Exit Sub
                End If
                
                If Folder32 Is Nothing And BitSize = "64-bit" Then
                    CreateUpdateAPIModule BitSize
                    Exit Sub
                End If
            End With
        Next objOS

End Sub

Sub CreateUpdateAPIModule(ByVal BitSize As String)

    Dim Cell        As Range
    Dim Rng         As Range
    Dim Text        As String
    Dim VBMod       As Object
    Dim Wks         As Worksheet
    
        Set Wks = Worksheets(BitSize & " API")
        Set Rng = Wks.UsedRange.Columns(1).Cells
        
        For Each Cell In Rng
            Text = Text & Cell.Value & vbCrLf
        Next Cell
        
        On Error Resume Next
            Set VBMod = ThisWorkbook.VBProject.VBComponents.Item("API_Calls")
        
            If Err = 9 Then
                Set VBMod = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)
                VBMod.Name = "API_Calls"
                VBMod.CodeModule.AddFromString Text
            End If
            
            If Err = 0 Then
                With VBMod.CodeModule
                    .DeleteLines 1, .CountOfLines
                    .AddFromString Text
                End With
            End If
        On Error GoTo 0

End Sub

[ronjon65]

Leith, that is quite clever. In this case, I am trying to keep it as simple as possible and the code on post #22 seems to be working fine. Unless there is an inherent issue there, I will go with that for now. Thanks.

[Leith Ross]

Hello ronjon65,

The code in Post #22 will work on 64 bit systems that have 32 bit Windows installed. If not then you will receive an error. You will also receive an error if the code is run on a 32 bit platform because PtrSafe and LongPtr are not part of the system's syntax.

The solution I have offered circumvents these problems because no API code is needed to test the system and then load the correct code. True, it is more complex but the complex part has been done for you. You only need to copy the API code and other associated macro code to the correct worksheet. The rest is automatic. The button can removed and a call placed in the Worksheet_Open() event module to perform the update when the workbook opens. Short code is not always the best code.

[ronjon65]

I catch your drift. I will give it a go. FYI, the code in #22 would seem to work in all but one scenario I guess?

64 bit OS with 32 bit Office - Tested and Works
64 bit OS with 64 bit Office - Tested and Works
32 bit OS with 64 bit Office - Not possible
32 bit OS with 32 bit Office - Untested but won't work per post #27?

[Leith Ross]

Hello ronjon65,

Nice table of results you made. Yes, you are correct.

[ronjon65]

Leith, so I was able to test on a 32 bit OS with 32 bit Office (2010) and the code on #22 works. But you stated it would not. Would it fail on a different version of Excel then (i.e 2003)?

So I am not sure what gives, but I can't find a scenario where #22 does not work. I do want to try the code on #25, but if #22 works fine (and no evidence so far that it will not) then that is the more direct approach.

Test cases:
Win 10 (64 bit) with Office 2013 (64bit) - Works
Win 10 (64 bit) with Office 2002 (32 bit) - Works
Win 10 (64 bit) with Office 2010 (32 bit) - Works
Win 7 (32 bit) with Office 2010 (32 bit) - Works

So all possible combinations of bit configurations work (3 possible) and works on 2003, 2010, 2013 (though not tested each on all 3 bit combinations). Exactly what scenario would fail and maybe I can test this?

[Aflatoon]

You should absolutely not use Long instead of LongPtr. Where did the type mismatch occur?

The whole point of conditional compilation is to make the code run on any system.

[ronjon65]

Within the Shell Function, the following lines exist. So this gets tripped up on 64 bit systems if LongPtr is used (best guess). If I comment out Option Explicit, then everything runs OK with LongPtr as part of the code. So maybe I should just remove the Option Explicit and leave the code with the LongPtr?

Dim lResult As Long
Dim lTaskID As Long
Dim lProcess As Long
Dim lExitCode As Long

[Aflatoon]

No - there is a reason for the error so you shouldn't simply try and ignore it. Please post the full code you have since those variables are not in anything posted to date. You need to use conditional compilation in the function too to ensure the correct types are passed to and returned from the API calls.

[ronjon65]

Here ya go. I don't know how to implement the conditional statement within the function though. So what is the risk of previous two methods, which are clearly not "correct"? So far, it works on everything I have tried. While I know it is not strictly correct, is it really an issue?

Function ShellWait(szCommandLine As String, Optional iWindowState As Integer = vbHide) As Boolean

Dim lResult As Long
Dim lTaskID As Long
Dim lProcess As Long
Dim lExitCode As Long
    
    On Error GoTo ErrorHandler

    lTaskID = Shell(szCommandLine, iWindowState)
    
    'Check for errors in the command line variable.
    If lTaskID = 0 Then Err.Raise 9999, , "Shell function error."
    
    'Get the process handle from the task ID returned by Shell.
    lProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0&, lTaskID)
    
    'Check if process was started
    If lProcess = 0 Then Err.Raise 9999, , "Unable to open Shell process handle."
    
    'Loop while the shelled process is still running.
    Do
        'lExitCode will be set to STILL_ACTIVE as long as the shelled process is running.
        lResult = GetExitCodeProcess(lProcess, lExitCode)
        DoEvents
    Loop While lExitCode = STILL_ACTIVE
    
    MeShellAndWait = True

Exit Function
    
ErrorHandler:
    gszErrMsg = Err.Number
    MeShellAndWait = False
End Function

[Aflatoon]

#If VBA7 Then
Dim lProcess As LongPtr
#Else
Dim lProcess As Long
#End If

If you pass/return the wrong data types with API calls the best you can hope for is a runtime error. More likely Excel will simply terminate and in extreme cases Windows will crash.

[ronjon65]

Well that did the trick. Thanks very much!

Aflatoon, do you have any comments about why Leith says the "simple" code (Post #4 with modified IF statement) will not work on all systems? Per my trials on post #30, I have tried it on every possible bit combination with success. My only question is if there is a bit combination + Excel version that it might possibly fail on?

[Aflatoon]

It won't work on a non Windows machine but other than that it will be fine for any combination of OS and Office.

[ronjon65]

Great, I was hoping you might say that