ExcelVBAでwindowsバージョン(10とか11とか) 返す

'OSのバージョンの数値を返す win10=10 win11=11
Function GetOsVersion()

    ' 取得結果を格納する変数を宣言
    Dim lnArchitecture As Long
    Dim strCaption As String
    Dim strCSDVersion As String
    Dim strOSVersion As String

    ' 初期値を入れておく
    lnArchitecture = 32
    strCaption = ""
    strCSDVersion = "Service Pack 0"

On Error Resume Next

    Dim objOS As Object
    Dim i As Long
    ' Connect to WMI and obtain instances of Win32_OperatingSystem
    For Each objOS In GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
        ' アーキテクチャの取得
On Error GoTo OSArchitectureNoSupport
        If InStr(1, CStr(objOS.OSArchitecture), "64", vbBinaryCompare) <> 0 Then
            lnArchitecture = 64
        End If

OSArchitectureNoSupport:
On Error Resume Next

        ' キャプションを取得
        For i = 1 To Len(objOS.Caption)
            Dim strTemp As String: strTemp = Strings.Mid$(objOS.Caption, i, 1)
            If AscW(strTemp) = &H2122 Then
                strCaption = strCaption & " TM"
            ElseIf AscW(strTemp) = &H24C7 Or AscW(strTemp) = &HAE Then
                strCaption = strCaption & "(R)"
            Else
                strCaption = strCaption & strTemp
            End If
        Next i

        ' SPを取得
        strCSDVersion = objOS.CSDVersion

        ' Versionを取得
        strOSVersion = objOS.Versionn
    Next
    
    GetOsVersion = FirstVal(strCaption)

    Set objOS = Nothing

End Function

'文字列の中から最初に見つかった数値をval()で変換して返す
Function FirstVal(str As String) As Integer

    Dim buf As String, RE, reMatch, reValue
    Set RE = CreateObject("VBScript.RegExp")
    buf = str
    With RE
        .Pattern = "\d+"
        .Global = True
        Set reMatch = .Execute(buf)
        If reMatch.count > 0 Then
            For Each reValue In reMatch
                FirstVal = Val(reValue)
                Exit For
            Next reValue
        End If
    End With
    Set RE = Nothing
    
End Function