'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
