vba Excel 中的 Office 版本和操作系统错误

Wrong Office version and Operating system in vba Excel

我运行这个代码在VBAExcel365使用Windows11

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

但是,我收到此消息“操作系统 Windows(64 位)NT 10.00,Office 版本 16.0 Build 15028”

属性 Application.Version 和 Application.OperatingSystem 显示的结果与我在 Excel 2016 年 运行 并使用 Windows 10 时的结果相同。

有什么建议可以获取真正的 Office 和 Windows 版本吗?

谢谢。

曼纽尔

上面评论中的 link 适用于 Office (Check the application version in modern office)。

我用这个 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