How to identify Access version

smig

Registered User.
Local time
Today, 19:21
Joined
Nov 25, 2009
Messages
2,209
How can Identify, using VBA, the Access version (2010, 2013, 2016, Office 365...) and type (32/64 bit) ?
 
I believe the following will give you the version number:

msgbox application.version
 
Public Sub subInstalledPrograms()

Dim objWMIService As Object
Dim colSoftware As Variant, objSoftware As Variant
Dim strComputer As String

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
("SELECT * FROM Win32_Product")
For Each objSoftware In colSoftware
Debug.Print objSoftware.Caption & vbTab & _
objSoftware.Description & vbTab & _
objSoftware.IdentifyingNumber & vbTab & _
objSoftware.InstallLocation & vbTab & _
objSoftware.InstallState & vbTab & _
objSoftware.Name & vbTab & _
objSoftware.PackageCache & vbTab & _
objSoftware.SKUNumber & vbTab & _
objSoftware.Vendor & vbTab & _
objSoftware.Version
Next
Set objWMIService = Nothing

End Sub

another through registry:

Public Sub subInstalledProgram2()
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Dim strComputer, strKey, objReg, arrSubkeys, strSubkey
Dim DisplayName, DisplayVersion, InstallDate, EstimatedSize, UninstallString
strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
'Get WMI object
Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
'Loop registry key.
For Each strSubkey In arrSubkeys
objReg.GetStringValue HKLM, strKey & strSubkey, "DisplayName", DisplayName
If DisplayName <> "" Then
objReg.GetStringValue HKLM, strKey & strSubkey, "DisplayVersion", DisplayVersion
objReg.GetStringValue HKLM, strKey & strSubkey, "InstallDate", InstallDate
objReg.GetDWORDValue HKLM, strKey & strSubkey, "EstimatedSize", EstimatedSize
If EstimatedSize <> "" Then
EstimatedSize = Round(EstimatedSize / 1024, 3) & " megabytes"
End If
Debug.Print DisplayName & vbTab & _
DisplayVersion & vbTab & _
InstallDate & vbTab & _
EstimatedSize
End If
Next
End Sub

.... or ....

Public Sub subInstalledProgram4()
Dim strComputer As String, strKey As String, strEntry1a As String, strKey64 As String
Dim strEntry1b As String, strEntry2 As String, strEntry3 As String
Dim objReg, strSubKey, arrSubkeys, intRet1, strValue1, intValue2, intValue3

Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"

strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry2 = "VersionMajor"
strEntry3 = "VersionMinor"

Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")

objReg.EnumKey HKLM, strKey, arrSubkeys
Debug.Print "Installed Applications" & vbCrLf

For Each strSubKey In arrSubkeys
intRet1 = objReg.GetStringValue(HKLM, strKey & strSubKey, strEntry1a, strValue1)
If intRet1 <> 0 Then
objReg.GetStringValue HKLM, strKey & strSubKey, strEntry1b, strValue1
End If
If strValue1 <> "" Then
objReg.GetDWORDValue HKLM, strKey & strSubKey, strEntry2, intValue2
objReg.GetDWORDValue HKLM, strKey & strSubKey, strEntry3, intValue3
If intValue2 <> "" Then
Debug.Print strValue1 & " [Version: " & intValue2 & "." & intValue3 & "]"
Else
Debug.Print strValue1
End If
End If
Next
 
Last edited:
Public Sub subInstalledPrograms()

Dim objWMIService As Object
Dim colSoftware As Variant, objSoftware As Variant
Dim strComputer As String

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
("SELECT * FROM Win32_Product")
For Each objSoftware In colSoftware
Debug.Print objSoftware.Caption & vbTab & _
objSoftware.Description & vbTab & _
objSoftware.IdentifyingNumber & vbTab & _
objSoftware.InstallLocation & vbTab & _
objSoftware.InstallState & vbTab & _
objSoftware.Name & vbTab & _
objSoftware.PackageCache & vbTab & _
objSoftware.SKUNumber & vbTab & _
objSoftware.Vendor & vbTab & _
objSoftware.Version
Next
Set objWMIService = Nothing

End Sub

another through registry:

Public Sub subInstalledProgram2()
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Dim strComputer, strKey, objReg, arrSubkeys, strSubkey
Dim DisplayName, DisplayVersion, InstallDate, EstimatedSize, UninstallString
strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
'Get WMI object
Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
'Loop registry key.
For Each strSubkey In arrSubkeys
objReg.GetStringValue HKLM, strKey & strSubkey, "DisplayName", DisplayName
If DisplayName <> "" Then
objReg.GetStringValue HKLM, strKey & strSubkey, "DisplayVersion", DisplayVersion
objReg.GetStringValue HKLM, strKey & strSubkey, "InstallDate", InstallDate
objReg.GetDWORDValue HKLM, strKey & strSubkey, "EstimatedSize", EstimatedSize
If EstimatedSize <> "" Then
EstimatedSize = Round(EstimatedSize / 1024, 3) & " megabytes"
End If
Debug.Print DisplayName & vbTab & _
DisplayVersion & vbTab & _
InstallDate & vbTab & _
EstimatedSize
End If
Next
End Sub

.... or ....

Public Sub subInstalledProgram4()
Dim strComputer As String, strKey As String, strEntry1a As String, strKey64 As String
Dim strEntry1b As String, strEntry2 As String, strEntry3 As String
Dim objReg, strSubKey, arrSubkeys, intRet1, strValue1, intValue2, intValue3

Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"

strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry2 = "VersionMajor"
strEntry3 = "VersionMinor"

Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")

objReg.EnumKey HKLM, strKey, arrSubkeys
Debug.Print "Installed Applications" & vbCrLf

For Each strSubKey In arrSubkeys
intRet1 = objReg.GetStringValue(HKLM, strKey & strSubKey, strEntry1a, strValue1)
If intRet1 <> 0 Then
objReg.GetStringValue HKLM, strKey & strSubKey, strEntry1b, strValue1
End If
If strValue1 <> "" Then
objReg.GetDWORDValue HKLM, strKey & strSubKey, strEntry2, intValue2
objReg.GetDWORDValue HKLM, strKey & strSubKey, strEntry3, intValue3
If intValue2 <> "" Then
Debug.Print strValue1 & " [Version: " & intValue2 & "." & intValue3 & "]"
Else
Debug.Print strValue1
End If
End If
Next

The first one seems to run for long time before I get the results.
For the other two I get "err 13 - Type mismatch" error on this line:
For Each strSubKey In arrSubkeys
arrSubkeys seems to be Null
 
sorry about that, must have been when i copy and paste the code, this is the correct one:

strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"

when you see the last word: "Uninsta ll"
replace it with: Uninstall

something wrong with copy and paste
 
Thanks
Both work now :)
The last one works much faster.

Looking for Access at the end result seems to be a nightmare.
I also found no evidance for the 32/64 bit thing.

I guess application.version is my best option for now.
 
Here is an other one in case you cannot decide which one to take :D
Code:
MsgBox SysCmd(acSysCmdAccessVer)
 
Thanks
Both work now :)
The last one works much faster.

Looking for Access at the end result seems to be a nightmare.
I also found no evidance for the 32/64 bit thing.

I guess application.version is my best option for now.

note that version is a string, rather than a number.
 
yes, "14.0" is actually a string, although access seems to convert it/treat it seamlessly as a number.

I haven't needed to establish the bitness - but I am sure there is a way.
 
what I mean is a real number should not be 14.00000. it should be a simple 14.
 
You can get the bit version with this :
Code:
Environ("PROCESSOR_ARCHITECTURE")
*Note: 32 bits = x86

After some research, it turns out that the code above only checks if the process that is running is 32bits or 64bits. So i figured that wouldn't help much if it is a 32 bit process on a 64 bits machine.
This is why i made this little function :

Code:
Function checkBitVersion() As String
    Dim sbits As String
    
    sbits = "64 bits"
    If Environ("PROCESSOR_ARCHITECTURE") = "x86" Then
        If Environ("PROCESSOR_ARCHITEW6432") = "" Then
            sbits = "32 bits"
        End If
    End If
    checkBitVersion = sbits
End Function

What it do is check if the process is 32 bits. That second if checks of %ProgramFiles% exists. (On this website : http://ss64.com/nt/syntax-variables.html i saw that it is only for 64 bits) So it should return "" on 32 bit machines and something else on 64 bits machines. (If someone can test that for me that would be great :) )
 
Last edited:
this one is cool, just pass the complete path and filename of executable file, ie:

CheckIf32Or64 "C:\Program Files\Microsoft Office\Office15\MSACCESS.EXE"

Code:
Public Sub CheckIf32Or64(sExecutableFile As String)
' source:
'
' http://www.visualbasicscript.com/Is-there-a-way-to-know-if-a-file-is-64bit-or-32bit-by-VBScript-m102111.aspx
'
'
Dim s As ADODB.Stream, b As Object
'create ADODB.Stream object for file binary read
Set s = CreateObject("ADODB.Stream")
' set type to binary, const adTypeBinary = 1
s.Type = 1
' open the stream
s.Open
' get the path to the executable file dropped onto script
' load a data from the executable file to the stream
s.LoadFromFile (sExecutableFile)
' create Microsoft.XMLDOM object
' create XMLDOM element for binary to heximal conversion
Set b = CreateObject("Microsoft.XMLDOM").createelement("binObj")
' set element datatype to retrieve hex
b.DataType = "bin.hex"
' MS-DOS header e_lfanew field located at 0x3C (60 decimal) contains 4-byte address, which is the Pointer to PE Header
' set the position at e_lfanew field in the stream
s.Position = 60
' read 4 bytes from e_lfanew field
' put read bytes to the XMLDOM element as binary data
b.nodetypedvalue = s.Read(4)
' read each byte from XMLDOM element in hex format as string
' mid function is used to crop the certain 2 hex chars which are equal to the corresponding byte of e_lfanew field
' multiplication of string concatenated of "&H" prefix and hex chars by the number is used for hex string to decimal coercion
' compute the address of PE Header by adding bytes multiplied by significance
' optional PE header follows directly after the standard PE header
' add 25 bytes offset to the PE Header begin, pointing to optional PE header
' set the new position in the stream at optional PE header
s.Position = 1 * ("&H" & Mid(b.Text, 1, 2)) + 256 * ("&H" & Mid(b.Text, 3, 2)) + 65536 * ("&H" & Mid(b.Text, 5, 2)) + 16777216 * ("&H" & Mid(b.Text, 7, 2)) + 25
' the optional PE header begins with a 2-byte magic code representing the architecture (0x010B for PE32, 0x020B for PE64, 0x0107 ROM)
' read the first byte from 2-byte magic field
' put read byte to the XMLDOM element as binary data
b.nodetypedvalue = s.Read(1)
' read the byte from XMLDOM element in hex format as string
' evaluate the byte: 02 for PE64, 01 for PE32 since ROM is few and far between
If b.Text = "02" Then
    MsgBox "Win 64 PE+"
Else
    MsgBox "Win 32 PE"
End If

End Sub
 
Check the registry key for the location of the ACCESS.EXE. If it is in Program Files then it would be 64 bit. If Program Files (x86) it would be 32 bit.

Code:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\MSACCESS.EXE\Path
 
you need to test your OS also, if you want to use the above code. since both x86 and x64 has Program Files directory.
 
Did a search of the google-brain.

This might be helpful:

http://officeone.mvps.org/vba/bitness.html

If I can choice between 30 lines of code or 4 lines of code who do the same thing, I would pick the one with the fewer lines.

Agree they are probably all good functions who do the job, but i like compact ones.

Check the registry key for the location of the ACCESS.EXE. If it is in Program Files then it would be 64 bit. If Program Files (x86) it would be 32 bit.

Code:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\MSACCESS.EXE\Path

What if I install office on a "E:" drive ? would this regkey still point to a program files path ?
 
Thank you all
Im happy to see it make all brains work together on this issue :)
 

Users who are viewing this thread

Back
Top Bottom