Wrong Office version and Operating system in vba Excel

Question

I am running this code in VBA Excel 365 using Windows 11

Sub test()
Dim sBuild As String, sOP As String, sVersion As String

sBuild = Application.Build
sOP = Application.OperatingSystem
sVersion = Application.Version
MsgBox "Operating System " & sOP & " with Office version " & sVersion & " Build " & sBuild

End Sub

However, I get this message "Operating System Windows (64-bit) NT 10.00 with Office version 16.0 Build 15028"

The properties Application.Version and Application.OperatingSystem shows the same results as if I was running in Excel 2016 and using Windows 10.

Any suggestion to get the real Office and Windows version?

Thank you.

Manuel

Answer 1

This link in the comment above works fine for Office (Check the application version in modern office).

I use this for Windows:

Function GetWindowsInfo() As String
  Dim oShell As Object
  Set oShell = CreateObject("WScript.Shell")
  Dim RegKeyProduct As String
  RegKeyProduct = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName"
  Dim ProductName As String
  ProductName = oShell.RegRead(RegKeyProduct)
  Dim VersionBuildNumbers(1 To 4) As Variant
  Dim RegKeyMajor As String
  RegKeyMajor = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentMajorVersionNumber"
  VersionBuildNumbers(1) = oShell.RegRead(RegKeyMajor)
  Dim RegKeyMinor As String
  RegKeyMinor = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentMinorVersionNumber"
  VersionBuildNumbers(2) = oShell.RegRead(RegKeyMinor)
  Dim RegKeyBuild As String
  RegKeyBuild = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentBuildNumber"
  VersionBuildNumbers(3) = oShell.RegRead(RegKeyBuild)
  If VersionBuildNumbers(3) >= 22000 Then
    ProductName = Replace(ProductName, "10", "11")
  End If
  Dim RegKeyUBR As String
  RegKeyUBR = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\UBR"
  VersionBuildNumbers(4) = oShell.RegRead(RegKeyUBR)
  Dim BuildNumber As String
  BuildNumber = oShell.RegRead(RegKeyBuild) & "." & oShell.RegRead(RegKeyUBR)
  Dim Bitness As String
  Bitness = "32-bit"
  If Len(Environ("PROGRAMFILES(x86)")) Then Bitness = "64-bit"
  GetWindowsInfo = "Microsoft " & ProductName & " (" & Join(VersionBuildNumbers, ".") & ") " & Bitness
End Function