I see the problem. The code should read either:
or:Code:#If VBA7 = 1 Then
or even:Code:#If VBA7 Then
but not:Code:#If CBool(VBA7) = True Then
Code:#If VBA7 = True Then
Printable View
I see the problem. The code should read either:
or:Code:#If VBA7 = 1 Then
or even:Code:#If VBA7 Then
but not:Code:#If CBool(VBA7) = True Then
Code:#If VBA7 = True Then
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?
Code:#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.
Code: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
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.
Code: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
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.
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.
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.
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?
Code: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.
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?
Code: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.Code:#If VBA7 Then
Dim lProcess As LongPtr
#Else
Dim lProcess As Long
#End If
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.
Great, I was hoping you might say that :)