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
    I see the problem. The code should read either:
    #If VBA7 = 1 Then 
    
    
    Formatting tags added by mark007
    or:
    #If VBA7 Then 
    
    
    Formatting tags added by mark007
    or even:
    #If CBool(VBA7) = True Then 
    
    
    Formatting tags added by mark007
    but not:
    #If VBA7 = True Then 
    
    
    Formatting tags added by mark007
    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 
    
    
    Formatting tags added by mark007

  3. #23
    VBAX Mentor Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    338
    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 
    
    
    Formatting tags added by mark007
    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
    338
    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 
    
    
    Formatting tags added by mark007
    Attached Files Attached Files
      To view attachments your post count must be 0 or greater. Your post count is 0 momentarily.
    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
    338
    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
    338
    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
    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 
    
    
    Formatting tags added by mark007

  13. #33
    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 
    
    
    Formatting tags added by mark007

  15. #35
    #If VBA7 Then 
        Dim lProcess As LongPtr 
    #Else 
        Dim lProcess As Long 
    #End If 
    
    
    Formatting tags added by mark007
    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
    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
  •