Kiểm tra phiên bản Office với VBA

[HeSanbi]

Ở bài viết này, tôi chia sẻ với các bạn một thủ tục được sưu tầm và chỉnh sửa lại, giúp các bạn có thể kiểm tra xem bạn đang sử dụng phiên bản Office bao nhiêu, và nhờ vậy chúng ta có thể kiểm tra xem, Excel của mình có sử dụng toán tử @ (Toán tử giao nhau ngầm định) có từ Excel 16, khóa # (Định nghĩa tham chiếu mảng) và ghi mảng vào bảng tính có trong Excel 2021 và Excel 365. Và trong VBA ta có thể biết được các phương thức mới như Formula2 của phương thức Range, và một số phương thức khác có trong phiên bản Excel 2021 và Excel 365.

Các bạn có thể sao chép mã dưới đây vào một Module trong dự án của bạn và chạy thử thủ tục test1 với nút F5 hoặc nhấn chạy Sub, mở cửa sổ Immediate với phím tắt Ctrl+G để xem thông tin in ra. Mã chỉ hoạt động với HĐH Windows.

Các bạn có thể tự kiểm tra xem, và chia sẻ lên bài viết này độ chính xác của mã.

Sub test1()
  Dim ver&, newVersion&, implicitIntersectionOperator$, SpillOperator$
  ver = OfficeVersion(newVersion, implicitIntersectionOperator, SpillOperator)
  Debug.Print "Version: " ver; newVersion; implicitIntersectionOperator, SpillOperator
End Sub

Private Function OfficeVersion(Optional newVersion As Long, Optional implicitIntersectionOperator$, Optional SpillOperator$) As Long

  Static n&, v&, i1$, i2$
  If v <> 0 Then Goto E
  Dim registryObject As Object
  Dim rootDirectory$
  Dim keyPath$
  Dim arrEntryNames As Variant
  Dim arrValueTypes As Variant
 
  Select Case Val(Application.Version)
  Case Is >= 16
    ' KiêÒm tra sýò tôÌn taòi cuÒa License key
    i1 = "@"
    Dim x%, p, l%, s$
    For Each p In Interaction.GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery( _
                                            "SELECT name FROM SoftwareLicensingProduct where name like '%office%'", , 48)
      s = p.Name
      For x = 15 To Len(s)
        If Mid$(s, x, 1) Like "#" Then
          l = l + 1
        Else
          If l = 3 Or l = 4 Then
            v = CLng(Mid$(s, x - l, l)):
            If v = 365 Or v >= 2021 Then i2 = "#": n = 1:
            GoTo E
          End If
          l = 0
        End If
      Next x
    Next p

    keyPath = "Software\Microsoft\Office\" & CStr(Application.Version) & "\Common\Licensing\LicensingNext"
    rootDirectory = "."
    Set registryObject = Interaction.GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & rootDirectory & "\root\default:StdRegProv")
    registryObject.EnumValues &H80000001, keyPath, arrEntryNames, arrValueTypes
    On Error GoTo ErrorExit
    For x = 0 To UBound(arrEntryNames)
      If InStr(arrEntryNames(x), "365") > 0 Then i2 = "#": n = 1: v = 365: Exit For
      If InStr(arrEntryNames(x), "2019") > 0 Then v = 2019: n = -1: Exit For
      If InStr(arrEntryNames(x), "2016") > 0 Then v = 2016: n = -1: Exit For
    Next x
  Case Is = 15: n = -1: v = 2013
  Case Is = 14: n = -1: v = 2010 'ProductCode: {91140000-0011-0000-1000-0000000FF1CE} 'CalculationVersion:  145621
  Case Is = 12: n = -1: v = 2007
  Case Else: i2 = "#": i1 = "@": n = 1: v = 2024
  End Select
E:
  newVersion = n: OfficeVersion = v: implicitIntersectionOperator = i1: SpillOperator = i2
Exit Function
ErrorExit:
  ' Phiên baÒn 16, nhýng không có maÞ câìp phép. PhaÒi là Office 2016
  v = 2016: n = -1: OfficeVersion = v: newVersion = n
End Function