Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 38 of 38

Thread: Shell and Wait - 32 bit and 64 bit

  1. #21
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,570
    Location
    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
    Be as you wish to seem

  2. #22
    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

  3. #23
    VBAX Mentor Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    366
    Location
    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
    Sincerely,
    Leith Ross

  4. #24
    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)?

  5. #25
    VBAX Mentor Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    366
    Location
    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
    Attached Files Attached Files
    Sincerely,
    Leith Ross

  6. #26
    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.

  7. #27
    VBAX Mentor Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    366
    Location
    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.
    Sincerely,
    Leith Ross

  8. #28
    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?

  9. #29
    VBAX Mentor Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    366
    Location
    Hello ronjon65,

    Nice table of results you made. Yes, you are correct.
    Sincerely,
    Leith Ross

  10. #30
    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?

  11. #31
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,570
    Location
    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.
    Be as you wish to seem

  12. #32
    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

  13. #33
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,570
    Location
    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.
    Be as you wish to seem

  14. #34
    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

  15. #35
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,570
    Location
    #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.
    Be as you wish to seem

  16. #36
    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?

  17. #37
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,570
    Location
    It won't work on a non Windows machine but other than that it will be fine for any combination of OS and Office.
    Be as you wish to seem

  18. #38
    Great, I was hoping you might say that

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •