I see the problem. The code should read either:
or:#If VBA7 = 1 Then
or even:#If VBA7 Then
but not:#If CBool(VBA7) = True Then
#If VBA7 = True Then
I see the problem. The code should read either:
or:#If VBA7 = 1 Then
or even:#If VBA7 Then
but not:#If CBool(VBA7) = True Then
#If VBA7 = True Then
Be as you wish to seem
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
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
"1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"
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)?
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
Sincerely,
Leith Ross
"1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"
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.
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
"1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"
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?
Hello ronjon65,
Nice table of results you made. Yes, you are correct.
Sincerely,
Leith Ross
"1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"
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?
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
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
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
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
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.#If VBA7 Then Dim lProcess As LongPtr #Else Dim lProcess As Long #End If
Be as you wish to seem
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?
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
Great, I was hoping you might say that