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
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.
ThanksHere is an other one in case you cannot decide which one to take
Code:MsgBox SysCmd(acSysCmdAccessVer)
Thanksnote that version is a string, rather than a number.
Environ("PROCESSOR_ARCHITECTURE")
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
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
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\MSACCESS.EXE\Path
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