Wrong Office version and Operating system in vba Excel-CodePudding

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

CodePudding user response：

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