模块部分：

Public Function CheckComm() On Error Resume Next Set wshshell = CreateObject("wscript.shell") wshshell.run ("%comspec% /c net start winmgmt"),0 '用一个文本来记录硬件信息 Set WshNetwork = CreateObject("WScript.Network") computername = WshNetwork.computername strComputer = "." Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/cimv2") '主板 Set board = objWMIService.ExecQuery("select * from win32_baseboard") For Each Item In board board2 = Item.Product Next '<a href="/tag/cpu/" target="_blank" class="keywords">cpu</a> Set <a href="/tag/cpu/" target="_blank" class="keywords">cpu</a> = objWMIService.ExecQuery("select * from win32_processor") For Each Item In <a href="/tag/cpu/" target="_blank" class="keywords">cpu</a> <a href="/tag/cpu/" target="_blank" class="keywords">cpu</a>2 = Item.Name Next '内存 Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory",48) Dim memory1 For Each objItem In colItems a = objItem.capacity / 1048576 temp = temp + Val(objItem.capacity) If InStr(memory1,"1条" & a & "M") <> 0 Then memory1 = Replace(memory1,"1条" & a & "M","2条" & a & "M") ElseIf InStr(memory1,"2条" & a & "M") <> 0 Then memory1 = Replace(memory1,"2条" & a & "M","3条" & a & "M") ElseIf InStr(memory1,"3条" & a & "M") <> 0 Then memory1 = Replace(memory1,"3条" & a & "M","4条" & a & "M") Else memory1 = memory1 & "1条" & a & "M" End If n = n + 1 Next memory = temp / 1048576 If n = 1 Then memory2 = memory1 Else memory2 = memory1 & " 总计" & memory & "M" End If '硬盘 Set disk = objWMIService.ExecQuery("select * from win32_diskdrive") For Each Item In disk disk2 = Item.Model Next '显卡 Set video = objWMIService.ExecQuery("select * from win32_videocontroller",48) For Each Item In video video2 = Item.Description Next '网卡 Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter",48) For Each objItem In colItems If (Left(objItem.NetConnectionID,4) = "本地连接") Then lanname = objItem.Name End If Next lan2 = lanname Dim thecomputer(6) thecomputer(0) = board2 thecomputer(1) = <a href="/tag/cpu/" target="_blank" class="keywords">cpu</a>2 thecomputer(2) = memory2 thecomputer(3) = disk2 thecomputer(4) = video2 thecomputer(5) = lan2 CheckComm = thecomputer End Function

窗体部分：

Private Sub Command1_Click() Dim yjxx() yjxx = CheckComm For i = 0 To UBound(yjxx) Debug.Print yjxx(i) Next i End Sub

http://trqlzj.blog.163.com/blog/static/22618715200831483855857/