最新消息

[公告2014/05/30] 如有需要將部落格中,任何一篇文章的程式碼使用在商業用途,請與我聯繫。

[公告2015/04/26] Line版的 iInfo程式與投資應用 群組已上線想加入的朋友們,請先查看 "入群須知" 再與我聯繫 Line : aminwhite5168,加入請告知身分與回答 "入群須知" 的問題。

[公告2018/04/22] 台北 Python + Excel VBA 金融資訊爬蟲課程,課程如網頁內容 金融資訊爬蟲班:台北班 Python 金融資訊爬蟲、EXCEL VBA 金融資訊爬蟲

[公告2019/01/08] 請注意:我再次重申,部落格文章的程式碼,是要提供各位參考與學習,一旦網頁改版請自行修改,別要求東要求西要我主動修改,你們用我寫東西賺錢了、交差了,請問有分我一杯羹嗎?既然賺錢沒分我,請問有什麼理由要求我修改,如果沒能力改,就花錢來找我上課。

[公告2019/12/01] 若各位有 Excel VBA 案子開發需求,歡迎與我聯繫,可接案處理。

[公告2020/05/22] 頁面載入速度慢,起因為部分JS來源(alexgorbatchev.com)失效導致頁面載入變慢,目前已做調整,請多見諒。

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

參考資料: