Find out if it is win32 or win64 by vba code

[return_of_hate]

Hi guys,

I would like to have a code where I can find if the end-user pc is win64 or win32 so that I can take the specific action on that. (which is, by the way, to add a path to environment variables after the instalation of matlab compiler, so that I can run my compiled matlab code as a subroutine in VBA).

Also, is there a way to add a path to windows path (in environemtnt variables) besides writing stuff in a .bat file and exceting a shell command to run the .bat file ????

Thanks,

[alex_read]

Part 1 could be performed like this:

Private Declare Function GetWindowsDirectory Lib "kernel32" _
Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Sub CommandButton1_Click()
    MsgBox (CStr(IsWindowsVersion64Bit))
End Sub

Private Function IsWindowsVersion64Bit() As Boolean
    IsWindowsVersion64Bit = False
    
    Dim lpBuffer As String
    Dim apiCallReturnValue As Long
    
    lpBuffer = Space(255)
    apiCallReturnValue = GetWindowsDirectory(lpBuffer, CLng(255))
    
    If (apiCallReturnValue <> 0) Then
        lpBuffer = Left(lpBuffer, apiCallReturnValue)
        If (Len(Dir(lpBuffer & "\SysWOW64\Regsvr32.exe")) <> 0) Then
            IsWindowsVersion64Bit = True
        End If
    End If
End Function

[alex_read]

& this should answer the second part also. Edit: There are deficiencies and restrictions rendering the SetEnvironmentVaraible, and to a lesser extent possibly the GetEnvironmentVariable API calls unuseable through a Word macro. Code will be left in as an example of the call, but be advised the below does not work through Word.

Private Declare Function GetWindowsDirectory Lib "kernel32" _
Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Declare Function SetEnvironmentVariable Lib "kernel32" _
Alias "SetEnvironmentVariableA" _
(ByVal lpName As String, ByVal lpValue As String) As Long

Private m_apiCallReturnValue As Long

Private Sub CommandButton1_Click()
    If (IsWindowsVersion64Bit = False) Then
        m_apiCallReturnValue = 0
        m_apiCallReturnValue = SetEnvironmentVariable("HELLO", "WORLD")
        
        If Not (m_apiCallReturnValue = 0) Then
            ' Succeeded
        End If
    End If
End Sub

Private Function IsWindowsVersion64Bit() As Boolean
    IsWindowsVersion64Bit = False
    
    Dim lpBuffer As String
    m_apiCallReturnValue = 0
    
    lpBuffer = Space(255)
    apiCallReturnValue = GetWindowsDirectory(lpBuffer, CLng(255))
    
    If (apiCallReturnValue <> 0) Then
        lpBuffer = Left(lpBuffer, apiCallReturnValue)
        If (Len(Dir(lpBuffer & "\SysWOW64\Regsvr32.exe")) <> 0) Then
            IsWindowsVersion64Bit = True
        End If
    End If
End Function

[dmaruca]

I started researching this because I didn't like determining what type of OS I'm using by finding a file. Looks like there is a WMI COM object that enumerates hardware and software properties. Read more here:

http://msdn.microsoft.com/en-us/libr...73(VS.85).aspx

Example script to get processor family:

Set objProc = GetObject("winmgmts:root\cimv2:Win32_Processor='cpu0'")

If objProc.Architecture = 0 Then
    Debug.Print "x86"
ElseIf objProc.Architecture = 9 Then
    Debug.Print "x64"
End If

And the OS:

On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
 & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")


Set colOSes = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOS in colOSes
  Debug.Print "Computer Name: " & objOS.CSName

  Debug.Print "Operating System"
  Debug.Print "  Caption: " & objOS.Caption 'Name
  Debug.Print "  Version: " & objOS.Version 'Version & build
  Debug.Print "  BuildNumber: " & objOS.BuildNumber 'Build
  Debug.Print "  BuildType: " & objOS.BuildType
  Debug.Print "  OSProductSuite: " & objOS.OSProductsuite 'OS Product suite
  Debug.Print "  OSArchitecture: " & objOS.OSArchitecture
  Debug.Print "  WOWEnvironment: " & objOS.WOWEnvironment
  Debug.Print "  OSType: " & objOS.OSType
  Debug.Print "  OtherTypeDescription: (2003 Server R2 release only)" & objOS.OtherTypeDescription
  Debug.Print "  ServicePackMajorVersion: " & objOS.ServicePackMajorVersion & "." & _
   objOS.ServicePackMinorVersion

Next

I'm still unclear how to determine the OS architecture, because the OSArchitecture property isn't available on most modern windows versions and you have these "x64 compatible" cpus that you can install 32 and 64 bit on.

There's more to learn, but this looks like the right path to me.

[dmaruca]

OK, so it appears OSArchitecture is vista only. You may have to parse the caption for the other 64 bit versions of windows. You can find a list here:

http://en.wikipedia.org/wiki/Compari...ndows_versions

It looks like XP and Server 2003 and 2008 can be 64 bit besides vista.

[alex_read]

Awesome job dmaruca! I couldn't for the life of me find a WMI sample, that's spot on and absolutely the best way to go about this! Nice job in hunting that down!

[alex_read]

Ok this isn't pretty at all! As per the edited post above, SetEnvironmentVariable and GetEnvironmentVariable Windows API calls do exist, but they are about as useful as a chocolate teapot!!!

This is a sample which uses Dmaruca's excellent WMI code sample, and the API registry calls to perform the setting of either User or System environment variables. Though I haven't littered this with as many comments as I might usually do, those in there should explain what it's basically achieving overall and why some design decisions were made. I suggest you place this into a module file, read the comments then forget all about it...

Option Explicit

Private Declare Function GetWindowsDirectory Lib "kernel32" _
Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Declare Function GetEnvironmentVariable Lib "kernel32" _
Alias "GetEnvironmentVariableA" (ByVal lpName As String, _
ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Declare Function SendMessageTimeout Lib "user32" _
Alias "SendMessageTimeoutA" (ByVal hwnd As Long, _
ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, _
ByVal fuFlags As Long, ByVal uTimeout As Long, _
lpdwResult As Long) As Long

Private Declare Function SHSetValue Lib "SHLWAPI.DLL" _
Alias "SHSetValueA" (ByVal hKey As Long, ByVal pszSubKey As String, _
ByVal pszValue As String, ByVal dwType As Long, _
pvData As String, ByVal cbData As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, _
phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, ByVal lpData As String, _
ByRef lpcbData As Long) As Long

Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_WININICHANGE As Long = &H1A
Private Const SMTO_ABORTIFHUNG As Long = &H2

Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const REG_EXPAND_SZ  As Long = 2
Private Const SHREGSET_FORCE_HKCU As Long = &H1
Private Const REG_SZ As Long = 1

Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_SET_VALUE  As Long = &H2
Private Const KEY_CREATE_LINK As Long = &H20
Private Const KEY_CREATE_SUB_KEY As Long = &H4
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_EVENT As Long = &H1
Private Const KEY_NOTIFY  As Long = &H10
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL)
Private Const KEY_ALL_ACCESS  As Long = ((STANDARD_RIGHTS_ALL Or _
  KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or _
  KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Private m_apiCallReturnValue As Long

Public Enum EnvironmentVariableType
    User = 0
    System = 1
End Enum


Public Function IsWindowsVersion64Bit() As Boolean
    IsWindowsVersion64Bit = False
    
    Dim objProc As Object
    Set objProc = GetObject("winmgmts:root\cimv2:Win32_Processor='cpu0'")
    If objProc.Architecture = 9 Then
        IsWindowsVersion64Bit = True
    End If
    Set objProc = Nothing
End Function


Public Function AppendEnvironmentVariable(ByVal environmentVariableName As String, _
ByVal value As String, valueSeparatorCharacter As String, _
variableType As EnvironmentVariableType) As Boolean
    AppendEnvironmentVariable = False
    
    Dim environmentVariableHive As Long
    Dim environmentVariableKey As String
    
    ' Rough comments here. There are 2 types of environment variables - user or system
    ' both correspond to registry locations. Here, those locations related to the
    ' environement variable type specified in this method's parameter, are setup.
    Select Case variableType
    Case EnvironmentVariableType.User
        environmentVariableHive = HKEY_CURRENT_USER
        environmentVariableKey = "Environment"
    Case EnvironmentVariableType.System
        environmentVariableHive = HKEY_LOCAL_MACHINE
        environmentVariableKey = "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"
    End Select
    
    ' Set the value to be set to the key (passed-into this method) into a variable. This
    ' will be the initial, default value, but will be altered to include any existing
    ' environment variable (registry key) values, if present, below.
    Dim pathEnvironmentVariable As String
    pathEnvironmentVariable = value
       
    Dim registryKeyHandle As Long
    
    ' The GetEnvironmentVariable cannot differenciate between user and system variables. If a
    ' variable with the same name exists in both, only the initial User one will be retreived
    ' which may not be required. Unfortunately, this means using the registry Win32 API methods
    ' to lookup the environment variable value and this uses the above set registry location
    ' variables. Here, the key is opened if it exists.
    m_apiCallReturnValue = 0
    m_apiCallReturnValue = RegOpenKeyEx(environmentVariableHive, environmentVariableKey, _
      CLng(0), KEY_ALL_ACCESS, registryKeyHandle)
      
    If (m_apiCallReturnValue = 0) Then
        Dim lpType As Long
        Dim registryValueBufferSize As Long
        
        ' 2 calls to query the registry key (corresponding to that of the passed-in method
        ' parameter environment variable name) are performed. 1 to get the text etc. sizes,
        ' another to use these sizes/buffer info and retreive the actual value.
        m_apiCallReturnValue = RegQueryValueEx(registryKeyHandle, environmentVariableName, _
          CLng(0), CLng(0), CLng(0), registryValueBufferSize)
          
        If (m_apiCallReturnValue <> 0) Then
            pathEnvironmentVariable = Space(registryValueBufferSize)
            m_apiCallReturnValue = RegQueryValueEx(registryKeyHandle, environmentVariableName, _
              CLng(0), CLng(0), pathEnvironmentVariable, registryValueBufferSize)
              
            ' If the environment variable exists and has a value, the passed-in value to set,
            ' along with the separator character are suffixed/appended to this.
            If (m_apiCallReturnValue = 0) Then
                pathEnvironmentVariable = RTrim(pathEnvironmentVariable)
                If (Asc(Right(pathEnvironmentVariable, 1)) = 0) Then
                    pathEnvironmentVariable = Left(pathEnvironmentVariable, _
                    Len(pathEnvironmentVariable) - 1)
                End If
                If (Right(pathEnvironmentVariable, 1) <> valueSeparatorCharacter) Then
                    pathEnvironmentVariable = pathEnvironmentVariable & valueSeparatorCharacter
                End If
                pathEnvironmentVariable = pathEnvironmentVariable & value
            End If
        End If
            
        RegCloseKey registryKeyHandle
    End If
    
    ' At this point we either have a new string of text to add to the environment variable,
    ' or any originally existing environment variable text value with the new string of text
    ' appended to this. In any case, we have a value to write. Again the SetEnvironmentVariable,
    ' as with the GetEnvironmentVariable API call has restrictions and doesn't work within the
    ' context of a word macro, so we revert to the Win32 API registry calls to write this value.
    m_apiCallReturnValue = 0
    m_apiCallReturnValue = SHSetValue(environmentVariableHive, _
      environmentVariableKey, environmentVariableName, REG_EXPAND_SZ, _
      ByVal pathEnvironmentVariable, _
      CLng(LenB(StrConv(pathEnvironmentVariable, vbFromUnicode)) + 1))
    
    ' A message is broadcast to let all windows know the environment variables have been updated.
    ' Therefore you should be able to use a DOS SET command or review the control panel system
    ' applet to see the change immediately.
    If (m_apiCallReturnValue = 0) Then
        m_apiCallReturnValue = SendMessageTimeout(HWND_BROADCAST, _
          WM_WININICHANGE, CLng(0), "Environment", SMTO_ABORTIFHUNG, _
          CLng(5000), m_apiCallReturnValue)
          
        ' If all went well, the method returns a true value. Otherwise it returns a false value
        ' following the execution of the End Function line below.
        If (m_apiCallReturnValue <> 0) Then
            AppendEnvironmentVariable = True
        End If
     End If
End Function

These are 2 examples of how you might call that code:

Private Sub CommandButton1_Click()
    Dim success As Boolean
    success = False
    
    If (IsWindowsVersion64Bit = True) Then
        success = AppendEnvironmentVariable("Path", "Chuck Norris", ";", System)
    End If
    MsgBox (success)
End Sub

Private Sub CommandButton1_Click()
    Dim success As Boolean
    success = False
    
    If (IsWindowsVersion64Bit = True) Then
        success = AppendEnvironmentVariable("Path", "Badger Badger Badger", ";", User)
    End If
    MsgBox (success)
End Sub

[alex_read]

Finally, as none of us seemed to spot this was your 1st post here, from all of us - welcome to the forums!

[return_of_hate]

Thanks for spotting my first post.

First of all lemme thank you all. You are awesome. Awesome ! Awesome !!!
This is the best forum I have ever visited (between all different kindda forums ). Such amazing replies !! I simply can't believe it.

I have been busy today. but I am going to try these out, and give u some results. However, I have found this too (not sure if it's gonna work).

Application.OperatingSystem

which gives out "windows (32-bit) NT 5.01"
so by searching this string, one can decide between 32 or 64-bit versions. But I am not sure how will this work on a 64-bit machine ?

Cheers

[alex_read]

Technically, you should be able to use something similar to this code, and you could replace that with string with "16", "64" or even "Mac", etc.

If Not Application.OperatingSystem Like "*32*" Then

However, according the the DeveloperDex forums, when the VBA "Application.OperatingSystem" runs on a 64-bit platform, it reports a 32-bit operating system (that was a little shortsighted of them, bad programming)! The guy mentioned he's reported this to MS, but it looks like you won't be able to use that call successfully unforunately.

That's the 3rd one in just this simgle thread now - SetEnvironmentVariable, GetEnvironmentVariable and Application.OperatingSystem which we've had to code around (successfully, might I add) due to the restrictions or bugs of these calls - maybe we should be applying to work on the Office or Windows API teams at Microsoft soon!!!

[dmaruca]

Hey return_of_hate,

I'm glad you like it here. We have quite a few knowledgeable people that hang around. I come here when I get bored at my desk - which is quite often.

I'm curious to know how all this code actually works on different installs. I can't vnc to my other machine because of some changes made to the firewall, so I can't test different installs using VMWare while at work. Maybe this weekend sometime.

That is some really nice code up there, alex_read. You really went above and beyond.