Access/Windows/Office365 Checker (1 Viewer)

Status
Not open for further replies.

isladogs

CID VIP
Local time
Today, 20:09
Joined
Jan 14, 2017
Messages
15,393
Attached is a utility for checking the following:
a) Windows version & bitness (32/64-bit)
b) Access version & bitness
c) Whether Office 365 is installed

This is an updated version of the utility originally posted at https://www.access-programmers.co.uk/forums/showthread.php?t=302789.
This update fixes issues on systems with 64-bit Windows and 32-bit Access

3 versions are provided (zipped) :
i) ACCDB for Access 2010 or later
ii) ACCDB version for Access 2007
iii) MDB version (Access 2000 format)

Save the appropriate version to a trusted location or click Enable Content
It will then automatically collect the info similar to that below.
It will take a few seconds to complete



A PDF Help file is included with each of the above but it can also be downloaded separately

=================================================

Detecting Access/Windows versions and 'bit-nesses' is relatively straightforward

However detecting Office 365 is more difficult because the same version numbering is used for both retail & subscription versions of Access.
Instead the code checks for a ClickToRun registry key - if it exists, you have Office 365.

For example, it looks for this key on pure 32-bit or pure 64-bit systems:
Code:
Computer\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\ClickToRun\REGISTRY\MACHINE\Software\Microsoft\Office\16.0\Access Connectivity Engine\Engines

For 32-bit Office on 64-bit Windows, it looks for:
Code:
Computer\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\Microsoft\Office\16.0\Access Connectivity Engine\Engines

However, it is not that ‘simple’. :rolleyes:
If a retail version of Office 2013/2016/2019 is installed but the user enters their Microsoft account information either during installation or at a later time, this triggers the ClickToRun registry structure to be created!

In other words, it is then treated as Office 365 even though it is still a retail product. However, the software is not updated with new features as is the case with a true Office 365 product

A further complication arises when using 32-bit applications in 64-bit Windows where registry entries are made to the Wow6432Node. Windows uses a process called registry redirection to manage this area.
However, that causes issues when trying to view those entries from a 32-bit application such as Access. 'Special code' is used to manage such cases

==================================================

Several functions are available for obtaining the Access version in varying degrees of detail.

- GetAccessVersion e.g. 14.0 for Access 2010
- GetAccessBuildVersion e.g. 14.0.7195 for Access 2010 SP2
- GetAccessEXEVersion e.g. Access 2010 SP2 14.0.7195

These are combined with another function IsOfficex64 which returns the value 32-bit or 64-bit

Code:
Function GetAccessVersion()
   'get Access version number e.g. 14.0 for Access 2010
   GetAccessVersion = SysCmd(acSysCmdAccessVer)
End Function
 
'=======================================
 
Function GetAccessBuildVersion() As String
   'Gets full Access version number including program updates / service packs
   'e.g. 14.6024 for Access 2010 SP1
   GetAccessBuildVersion = Nz(SysCmd(acSysCmdAccessVer) & "." & SysCmd(715), "None") & " " & IsOfficex64
   'Debug.Print GetAccessBuildVersion
End Function
 
'=======================================
 
Function GetAccessEXEVersion() As String
 
   'Valid for use with Access 2000 or later.
   'Original version may have been by Tom van Stiphout
   
   On Error Resume Next
   Dim sAccessVerNo As String
   
   sAccessVerNo = SysCmd(acSysCmdAccessVer) & "." & SysCmd(715)
   
   Select Case sAccessVerNo
       'Access 2000
       Case "9.0.0.0000" To "9.0.0.2999": GetAccessEXEVersion = "Access 2000 " & sAccessVerNo & ""
       Case "9.0.0.3000" To "9.0.0.3999": GetAccessEXEVersion = "Access 2000 SP1 " & sAccessVerNo & ""
       Case "9.0.0.4000" To "9.0.0.4999": GetAccessEXEVersion = "Access 2000 SP2 " & sAccessVerNo & ""
       Case "9.0.0.6000" To "9.0.0.6999": GetAccessEXEVersion = "Access 2000 SP3 " & sAccessVerNo & ""
       
       'Access 2002
       Case "10.0.2000.0" To "10.0.2999.9": GetAccessEXEVersion = "Access 2002 " & sAccessVerNo & ""
       Case "10.0.3000.0" To "10.0.3999.9": GetAccessEXEVersion = "Access 2002 SP1 " & sAccessVerNo & ""
       Case "10.0.4000.0" To "10.0.4999.9": GetAccessEXEVersion = "Access 2002 SP2 " & sAccessVerNo & ""
       
       'Access 2003
       Case "11.0.0000.0" To "11.0.5999.9999": GetAccessEXEVersion = "Access 2003 " & sAccessVerNo & ""
       Case "11.0.6000.0" To "11.0.6999.9999": GetAccessEXEVersion = "Access 2003 SP1 " & sAccessVerNo & ""
       Case "11.0.7000.0" To "11.0.7999.9999": GetAccessEXEVersion = "Access 2003 SP2 " & sAccessVerNo & ""
       Case "11.0.8000.0" To "11.0.8999.9999": GetAccessEXEVersion = "Access 2003 SP3 " & sAccessVerNo & ""
       
       'Access 2007
       Case "12.0.0000.0" To "12.0.5999.9999": GetAccessEXEVersion = "Access 2007 " & sAccessVerNo & ""
       Case "12.0.6211.0" To "12.0.6422.9999": GetAccessEXEVersion = "Access 2007 SP1 " & sAccessVerNo & ""
       Case "12.0.6423.0" To "12.0.9999.9999": GetAccessEXEVersion = "Access 2007 SP2 " & sAccessVerNo & ""
       
       'Access 2010
       Case "14.0.0000.0000" To "14.0.6022.1000": GetAccessEXEVersion = "Access 2010 " & sAccessVerNo & ""
       Case "14.0.6023.1000" To "14.0.7014.9999": GetAccessEXEVersion = "Access 2010 SP1 " & sAccessVerNo & ""
       Case "14.0.7015.1000" To "14.0.9999.9999": GetAccessEXEVersion = "Access 2010 SP2 " & sAccessVerNo & ""
       
       'Access 2013
       Case "15.0.0000.0000" To "15.0.4569.1505": GetAccessEXEVersion = "Access 2013 " & sAccessVerNo & ""
       Case "15.0.4569.1506" To "15.0.9999.9999": GetAccessEXEVersion = "Access 2013 SP1 " & sAccessVerNo & ""
       
        'Access 2016/2019/365
       Case "16.0.0000.0000" To "16.0.99999.9999"
           Select Case CInt(Mid(sAccessVerNo, 6))
           
           'A2019 started at approx 16.0.10827.20138
           Case Is < 10827
               GetAccessEXEVersion = "Access 2016 " & sAccessVerNo & ""
           Case Else
               GetAccessEXEVersion = "Access 2019 " & sAccessVerNo & ""
           End Select
       
       Case Else
       GetAccessEXEVersion = "Access - Unknown Version"
       
   End Select
   
   If SysCmd(acSysCmdRuntime) Then GetAccessEXEVersion = GetAccessEXEVersion & " Run-time"
   
   GetAccessEXEVersion = GetAccessEXEVersion & " " & IsOfficex64
   
  ' Debug.Print GetAccessEXEVersion
End Function
 
'=======================================
 
Function IsOfficex64()
  'checks if Office is 32 or 64 bit
 
 #If Win64 Then
    IsOfficex64 = "64-bit"
 #Else
    IsOfficex64 = "32-bit"
 #End If
 
 'Debug.Print IsOfficex64
 
End Function

To obtain the Windows version and bitness, the following code is used:

Code:
Public Function GetOperatingSystem()
   Dim localHost       As String
   Dim objWMIService   As Variant
   Dim colOperatingSystems As Variant
   Dim objOperatingSystem As Variant
 
   On Error GoTo Err_Handler
 
   localHost = "." 'Technically could be run against remote computers, if allowed
   Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & localHost & "\root\cimv2")
   Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
 
   For Each objOperatingSystem In colOperatingSystems
       GetOperatingSystem = objOperatingSystem.Caption & " " & objOperatingSystem.Version
     '  Exit Function
   Next
 
  ' Debug.Print GetOperatingSystem
   
   'Determine if operating system is 32-bit or 64-bit
   '-------------------------------------------------
   GetOperatingSystem = GetOperatingSystem & " " & IsWin32OrWin64
   
   'Debug.Print GetOperatingSystem
   
Exit_Handler:
  ' On Error Resume Next
   Exit Function
 
Err_Handler:
   FormattedMsgBox "Error " & Err.Number & " in GetOperatingSystem procedure :             " & _
       "@" & Err.Description & "            @", vbCritical, "Program error"
   Resume Exit_Handler

End Function


'=======================================
 
Function IsWin32OrWin64()
 
  'Determine if operating system is 32-bit or 64-bit
   '-------------------------------------------------
   'Modified from code provided at:
   '  http://www.vb-helper.com/howto_get_os_name.html
   Dim proc_query As String
   Dim proc_results As Object
   Dim Info As Object
   
   proc_query = "SELECT * FROM Win32_Processor"
   Set proc_results = GetObject("Winmgmts:").ExecQuery(proc_query)
   For Each Info In proc_results
       IsWin32OrWin64 = Info.AddressWidth & "-bit"
   Next Info
   
   'Debug.Print IsWin32OrWin64
 End Function

The code used to check for Office 365 is based on the following:

Code:
Function CheckAccess365() As Boolean
 
 On Error GoTo Err_Handler
   
   'If Access version <16.0 then NOT A365
   'However in case of dual Office installation, this step will be bypassed
 '  If CInt(GetAccessVersion) < 16 Then
 '      CheckAccess365 = False
 '       Debug.Print "Access 365 : " & CheckAccess365
 '        Exit Function
 '  End If
   
   'Check Windows bitness
   If IsWin32OrWin64 = "32-bit" Then
           registryKey = "SOFTWARE\Microsoft\Office\ClickToRun\REGISTRY\MACHINE\Software\Microsoft\Office\16.0\" & _
                                          "Access Connectivity Engine\Engines"
   Else '64-bit Windows
       'check Office bitness
       If IsOfficex64 = "32-bit" Then
          'check in Wow6432Node
           registryKey = "SOFTWARE\Microsoft\Office\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\" & _
                                           "Microsoft\Office\16.0\Access  Connectivity Engine\Engines"
       Else '64-bit Office
           registryKey = "SOFTWARE\Microsoft\Office\ClickToRun\REGISTRY\MACHINE\Software\Microsoft\Office\16.0\" & _
                                           "Access Connectivity Engine\Engines"
       End If
   End If
   
   KeyName = "SystemDB" 'look for specific string value
   
   ' check string value exists in registry
    If GetStringValFromRegistry(HKEY_LOCAL_MACHINE, registryKey, KeyName) <> "" Then
           CheckAccess365 = True
   End If
   
  ' Debug.Print "Access 365 : " & CheckAccess365
   
 Exit_Handler:
      Exit Function
   
 Err_Handler:
     MsgBox "Error " & Err.Number & " in CheckAccess365 procedure: " & Err.Description
     Resume Exit_Handler
 End Function

As mentioned above, the Wow6432Node registry area cannot be read from or written to using standard code as used on ’pure’ 32-bit or 64-bit systems.
Instead, I have used ‘special’ code which is elevated to 64-bit as and when required

Code:
Public Function GetStdRegProv() As Object
   ' http://msdn.microsoft.com/en-us/library/aa394600(VS.85).aspx
   'code updated by Jeff Holm to manage mixed mode systems

  On Error GoTo ErrHandler:
    
    Dim strComputer As String
 
    strComputer = "."
    
    If IsWin32OrWin64 = IsOfficex64 Then    'Office & Windows bitness match, no need to force 64-bit
 
        Set GetStdRegProv = GetObject("winmgmts:" _
                                    & "{impersonationLevel=impersonate}!\\" _
                                    & strComputer & "\root\default:StdRegProv")
                                    
    Else    'Office 32-bit & Windows 64-bit, so have to elevate GetStdRegProv to 64-bit

        Dim objCtx As Object
        Dim objLocator As Object
        Dim objServices As Object
        Dim objStdRegProv As Object

        Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
        objCtx.Add "__ProviderArchitecture", 64
        objCtx.Add "__RequiredArchitecture", True
        Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
        Set objServices = objLocator.ConnectServer(strComputer, "root\default", "", "", , , , objCtx)
        Set GetStdRegProv = objServices.Get("StdRegProv")

        Set objServices = Nothing
        Set objLocator = Nothing
        Set objCtx = Nothing
    End If
    
  Exit_ErrHandler:
    On Error Resume Next
    Exit Function
    
  ErrHandler:
    If Err.Number >= 0 Then
        MsgBox "Error " & Err.Number & " in GetStdRegProv procedure: " & Err.description, vbOKOnly + vbCritical
    End If
    Resume Exit_ErrHandler
    
End Function

NOTE:
I have successfully tested the Office365 code on several PCs with:
- Windows/Access both 32-bit
- Windows/Access both 64-bit
- 64-bit Windows & 32-bit Access
- dual installation of Access 2010 & Access 365 (as in the screenshot above)

Many thanks to several other users who tested this on their own computer systems. Particular thanks are due to Utter Access forum member Jeff Holm for repeatedly testing different versions in 'mixed bitness' systems and for helping to solve issues related to reading the Wow6432Node registry area

Despite the extensive testing already done, it is possible that some Office365 users may have different registry keys to those being referenced. If so, the code will NOT detect Office 365

I would be grateful for feedback from any Office 365 users who find that the check does not work correctly

If that is the case, please email me with the following information:
a) Access/Windows versions & bitnesses
b) the full registry key path in HKEY_LOCAL_MACHINE containing the ClickToRun key for the Access Connectivity Engines\Engines folder

Thanks
 

Attachments

  • A2019(365).PNG
    A2019(365).PNG
    8.7 KB · Views: 630
  • AccessVersionChecker2010_v2.2.zip
    352.5 KB · Views: 212
  • AccessVersionChecker2007_v2.2.zip
    346 KB · Views: 168
  • AccessVersionChecker2000_v2.2.zip
    346 KB · Views: 174
  • AccessVersionCheckerHelp_PDF.zip
    293.4 KB · Views: 175
Last edited:
Status
Not open for further replies.

Users who are viewing this thread

Top Bottom