2018年11月23日 星期五

Excel VBA 取得作業系統版本

有時候程式運作的需要在 Excel VBA 中取得作業系統版本，要在 Excel VBA 上可使用系統 DLL 元件與 WMI 來取得。
系統DLL元件引用。
Option Explicit

#If Win64 Then
    Type OSVERSIONINFO   '  148 Bytes
            dwOSVersionInfoSize As LongPtr
            dwMajorVersion As LongPtr
            dwMinorVersion As LongPtr
            dwBuildNumber As LongPtr
            dwPlatformId As LongPtr
            szCSDVersion As String * 128
    End Type
    
    Declare PtrSafe Function GetVersionEx Lib "kernel32" _
    Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As LongPtr
#Else
    Type OSVERSIONINFO   '  148 Bytes
            dwOSVersionInfoSize As Long
            dwMajorVersion As Long
            dwMinorVersion As Long
            dwBuildNumber As Long
            dwPlatformId As Long
            szCSDVersion As String * 128
    End Type

    Declare Function GetVersionEx Lib "kernel32" _
    Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
#End If

Sub 執行()
    Dim Major As Integer, Minor As Integer
    
    GetWinVer Major, Minor
    MsgBox  Major & "." & Minor
End Sub

Function GetWinVer(ByRef Major As Integer, ByRef Minor As Integer)
    Dim OSVer As OSVERSIONINFO
#If Win64 Then
    Dim rc As LongPtr
#Else
    Dim rc As Long
#End If

    OSVer.dwOSVersionInfoSize = 148
    OSVer.szCSDVersion = Space$(128)
    rc = GetVersionEx(OSVer)
    
    With OSVer
        Major = .dwMajorVersion
        Minor = .dwMinorVersion
        Select Case Major + Minor / 10
            Case 5#
                GetWinVer = "Windows 2000"
            Case 5.1
                GetWinVer = "Windows XP (32-bit)"
            Case 5.2
                GetWinVer = "Windows XP (64-bit), 2003 Server, Home Server"
            Case 6#
                GetWinVer = "Windows Vista, 2008 Server"
            Case 6.1
                GetWinVer = "Windows 7, 2008 Server R2"
            Case 6.2
                GetWinVer = "Windows 8, 2012 Server"
            Case 6.3
                GetWinVer = "Windows 8.1, 2012 Server R2"
            Case 10#
                GetWinVer = "Windows 10, 2013 Server"
            Case Else
                GetWinVer = "Other version"
        End Select
    End With
End Function

參考資料：
於