VBAでOS判定(XP~Win10 2004)

[非推奨]シンプルなOSバージョン判定方法

OSの名称を取得できるApplication.OperatingSystemを使う方法です。
このプロパティにアクセスすると、こんな文字列が返ってきます。

Windows (32-bit) NT 6.01

NT以降の数値がOSのバージョンです。
ちなみにここ数年出ているMicrosoft Office for Macでも、ちゃんと

Macintosh 7.00

とか返してくれるらしいですが、Mcは専門外なので割愛。
そんなわけで、”NT”より右側をVal()でDouble型に変換して判定します。

OSバージョン番号
Windows XP5.01
Windows Vista6
Windows 76.01
Windows 86.02
Windows 8.1後述
Windows 10後述

注意するべきことが2つ

まずは”(32-bit)”ですが、これはOS = 32bitとは限りません。
なぜなら64bitOSでもインストールしたOfficeが32bit版なら”(32-bit)”となるからです。
つまりOSではなく、Officeのアーキテクチャですね。

次に一般的なWindowsマシンならこれで十分でしょうが、Server等も含めちゃうと、このNT以降の数値が意外にもユニークじゃなさそうなんですよね。
詳しくはWikipediaのWindows のタイムライン表を参照してください。
実はExcel5では正しい値を返さないという不具合もMicrosoftから報告されていますが、さすがにこんな古いの使っている人はいないと信じたい…。

ここで困ったことが…

Windows 8 = 6.02以降、
Windows 8.1 = 6.03が返ってきて欲しいのに6.02が、
Windows10は利用環境によって6.02やら.00と意味不明な値が返ってきます。
ので、例外すっ飛ばないようにNT以降の文字列をVal()で数値に変換して、0または6.02以降であれば以下のWin32_OperatingSystemから改めてバージョン番号を取得/判別が必要です。
要するに、現代ではこの方法はナンセンスということですね。

[推奨]ちょい高度なOSバージョン判定方法

Application.OperatingSystemだとOSのアーキテクチャもエディションもわからない。
それじゃあ心許ない人はWin32_OperatingSystemを使います。
その名の通り、WindowsOSの情報が取得できます。

OSのアーキテクチャ、ServicePack、キャプションを取得してみます。

    ' 取得結果を格納する変数を宣言
    Dim lnArchitecture As Long
    Dim strCaption As String
    Dim strCSDVersion As String
    Dim strOSDVersion 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を取得
        strOSDVersion = objOS.Versionn
    Next

    Set objOS = Nothing

ソースの通りです、だとやや寂しいので少し説明。

objOS変数にWin32_OperatingSystemクラスオブジェクトが入り、各プロパティを参照するわけですが、OSArchitectureプロパティを参照する前にOn Error GoTo文を入れているのは、Windows XP(32bit版)ではこのプロパティをサポートしておらず、例外が発生するためです。
On Error Resume NextのままだとIf文の中に入ってしまいますので。
つまり例外が出る = サポートしてないプロパティ = このOSは32bitです。

次に、Captionプロパティを取得後に色々やってますが、これはVistaのエディション名にUnicodeの登録商標マーク(Rを丸で囲った文字やTMを一文字にしたもの)が使われていて、これをダイアログでだそうとすると文字化けするんですよファーック!
というわけで、置き換えてます。
ちなみにこれでとれたキャプションはこんな感じです。

Microsoft Windows 7 Home Premium

さて、Windows8以降はApplication.OperatingSystemで上手く値が取れないので、strOSVersionに必要な情報を取得しました。
メジャーバージョン、マイナーバージョン、ビルド番号がドット区切りで取れるので、Strings.Splitで分解してあげてください。
メジャーバージョンが6ならマイナーバージョンをチェックし、

0:Windows Vista
1:Windows 7
2:Windows 8
3:Windows 8.1
4:Windows 10 InsiderPreview

メジャーバージョンが10なら、マイナーバージョンをチェックし(いらないかな?)、

0:Windows 10 InsidersPreview/正式版

さらにビルド番号をチェックして、

10240未満:Windows 10 InsidersPreview
10240以降:Windows 10 正式版 1507)
10586以降:November Update 1511)
14393以降:Anniversary Update 1607)
15063以降:Creators Update 1703)
16299以降:Fall Creators Update 1709)
17134以降:April 2018 Update (1803)
17763以降:Octover 2018 Update 1809)
18362以降:May 2019 Update 1903)
18363以降:November 2019 Update 1909)
19041以降:May 2020 Update(2004)

とチェックしていきましょう。
Windows10は3月と9月に毎年大型Updateするとか…。
Windows10の各バージョンがいつサポート終了するかはこちらを参照してください。
https://support.microsoft.com/ja-jp/help/13853/windows-lifecycle-fact-sheet

(2020/4/16追記)
2020/4/15、新型コロナウイルス感染症の影響を受け、Windows10 1809のサポート終了日が2020/5/12から2020/11/10に延期されました。
1903以降がどうなるのか現時点で不明です。

Excelの判定は?


他にもニッチなIT関連要素をまとめていますので、よければ一覧記事もご覧ください。

1件のコメント

返信を残す

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)