VBA获取您的电脑硬件信息

原帖地址：http://blog.csdn.net/jacky_think/article/details/4621049

 自 ： http://club.excelhome.net/thread-395989-1-9.html

1. 获取主板序列号(注意并不是所有的主板都可以获得)

[vb] view plain copy

1. Sub 主板序列号()  
2.     Dim objs As Object, Obj As Object, WMI As Object, 主板序列号  
3.     Set WMI = GetObject("WinMgmts:")  
4.     Set objs = WMI.InstancesOf("Win32_BaseBoard")  
5.     For Each Obj In objs  
6.        MsgBox "您的主板序列号是：" + Obj.SerialNumber  
7.     Next  
8. End Sub  

 

2. 显示显卡信息

[vb] view plain copy

1. Sub 显卡信息()  
2. On Error Resume Next  
3. Dim tmp1, tmp2  
4. Set tmp2 = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_VideoController")  
5. For Each tmp1 In tmp2  
6. MsgBox "型 号: " & tmp1.VideoProcessor & vbCrLf & "厂 商: " & tmp1.AdapterCompatibility & vbCrLf & "名 称: " & tmp1.Name & vbCrLf & "状 态: " & tmp1.Status & vbCrLf & "显 存: " & (tmp1.AdapterRAM / 1024000) & "MB" & vbCrLf & "驱 动(dll): " & tmp1.InstalledDisplayDrivers & vbCrLf & "驱 动(inf): " & tmp1.infFilename & vbCrLf & "版 本: " & tmp1.DriverVersion  
7. Next  
8. End Sub  

 

3. 显示网卡信息

[vb] view plain copy

1. Sub 网卡MAC()  
2. Dim 网卡  
3. Set 网卡 = GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")  
4. For Each 地址 In 网卡  
5. If 地址.IPEnabled = True Then  
6. MsgBox "网卡MAC地址: " & 地址.MacAddress  
7. Exit For  
8. End If  
9. Next  
10. End Sub  

 

4. 显示硬盘型号

[vb] view plain copy

1. Sub 硬盘型号()  
2. Dim 硬盘  
3. Set 硬盘 = GetObject("Winmgmts:").InstancesOf("Win32_DiskDrive")  
4. For Each mo In 硬盘  
5. MsgBox "硬盘型号为:" & mo.Model  
6. Next  
7. End Sub  

 

5.显示cpu序列号

[vb] view plain copy

1. Sub CPU序列号()   
2. '特别提示：这个不是唯一的，即有可能多个CPU同一一序列号  
3. For Each 序列 In GetObject("Winmgmts:").InstancesOf("Win32_Processor")  
4. MsgBox "CPU 序列号: " & CStr(序列.ProcessorId)  
5. Next  
6. End Sub  

 

6.显示所有进行信息

[vb] view plain copy

1. Sub 所有进程()  
2. Set objs = GetObject("WinMgmts:").InstancesOf("Win32_Process")  
3. For Each obj In objs  
4. tmp = tmp & WorksheetFunction.Text(a + 1, "[DBNum2][$-804]0:  ") + vbTab + obj.Description + Chr(13)  
5. a = a + 1  
6. Next  
7. MsgBox tmp, 65, "提示你哦"  
8. End Sub