חוקי הפורום

קודי VBA לאקסס שמחזירים מידע על המערכת, קיים?



  • כגון גירסת מע' ההפעלה, דגם המחשב וכו'.

    א"כ אשמח שביאו לכאן, תודה!



  • זה דוגמא שמצאתי בחיפוש גוגל למציאת גירסת מערכת הפעלה

    Public Function GetOSName()
        On Error GoTo Fejl
        Dim ObjWMIservice As Object, ColItems As Object, ObjItem As Object
        
        Set ObjWMIservice = GetObject("winmgmts:\\.\root\cimv2")
        Set ColItems = ObjWMIservice.ExecQuery("SELECT * FROM Win32_OperatingSystem", , 48)
        For Each ObjItem In ColItems
            GetOSName = ObjItem.Name
        Next
        
        GetOSName = Left(GetOSName, InStr(GetOSName, "|") - 1)
        GetOSName = Trim(Mid(GetOSName, InStr(15, GetOSName, " "), 4))
        Select Case GetOSName
            Case 10: GetOSName = 10
            Case 8.1: GetOSName = 8
            Case 7.1, 7: GetOSName = 7
            Case Else: GetOSName = 5
        End Select
        Set ObjItem = Nothing
        Set ColItems = Nothing
        Set ObjWMIservice = Nothing
    ExitHer:
        Exit Function
    Fejl:
        MsgBox Err.Description, , ""
        Resume ExitHer
    End Function
    

    אבל יש לי עוד הרבה וזה שמור באיזה פרוייקט שלי,
    תפרט איזה נתונים אתה צריך לקבל, אולי השתמשתי בזה.



  • Sub GetWindowsVersion()
        Dim SysReport As String
      
    'Check Windows version.
    'based on: http://answers.microsoft.com/en-us/office/forum/office_xp-access/VBA-to-find-windows-version/1a1e72f5-0b4a-4c6a-ba4c-a6964f4ee4cc
        Dim objWMIService As Variant
        Dim colOperatingSystems As Variant
        Dim objOperatingSystem As Variant
        Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ".\root\cimv2")
        Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
        For Each objOperatingSystem In colOperatingSystems
            SysReport = SysReport & "The operating system on this computer is " & _
                objOperatingSystem.Caption & "  (" & objOperatingSystem.Version & ")"
        Next
        
    'Determine if operating system is 32-bit or 64-bit
    '-------------------------------------------------
    'Modified from code provided at:
    '  http://www.vb-helper.com/howto_get_os_name.html
        Dim proc_query As String
        Dim proc_results As Object
        Dim info As Object
        Dim IsWin32OrWin64 As String
        
        proc_query = "SELECT * FROM Win32_Processor"
        Set proc_results = GetObject("Winmgmts:").ExecQuery(proc_query)
        For Each info In proc_results
            IsWin32OrWin64 = info.AddressWidth & "-bit"
        Next info
        SysReport = SysReport & " " & IsWin32OrWin64 & "."
        
    Debug.Print SysReport
    End Sub
    
    

    תוצאה:

    The operating system on this computer is þþMicrosoft Windows 10 Pro  (10.0.18363) 64-bit.
    


  • Sub Main()
    Set objWMIService = GetObject("winmgmts://./root/cimv2")
    
    Set ColItems = objWMIService.ExecQuery("Select * from Win32_BIOS where PrimaryBIOS = true", , 48)
    
    For Each ObjItem In ColItems
        strMsg = strMsg _
               & "    BIOS Name       :  " & ObjItem.Name & vbCrLf _
               & "    Version         :  " & ObjItem.Version & vbCrLf _
               & "    Manufacturer    :  " & ObjItem.Manufacturer & vbCrLf _
               & "    Serial Number   :  " & ObjItem.SerialNumber & vbCrLf _
               & "    SMBIOS Version  :  " & ObjItem.SMBIOSBIOSVersion & vbCrLf
    Next
    
    Debug.Print strMsg
    End Sub
    
        BIOS Name       :  Phoenix BIOS SC-T v2.1
        Version         :  LENOVO - 2400
        Manufacturer    :  LENOVO
        Serial Number   :  R9022X21
        SMBIOS Version  :  GNET92WW (2.40 )
    

    מקור
    https://www.tek-tips.com/viewthread.cfm?qid=1105123


התחבר כדי לפרסם תגובה
 

בא תתחבר לדף היומי!