vba搜集硬件信息

Sub hardwareinfo()

On Error Resume Next
''Set fso = CreateObject("Scripting.FileSystemObject")
'Set f1 = fso.CreateTextFile("1.csv")
strComputer = "."
strcomputername = ""
strhardwareinfo = ""
stripaddress = ""
strmacaddress = ""
strdate = (FormatDateTime(Date, 2))
Set sh = Sheets("硬件信息")
Worksheets("硬件信息").Unprotect Password:="111111" '取消密码保护
Sheets("硬件信息").Range("2:65536").Clear '从第二行开始清空工作表
If Err.Description = "" Then
'搜集系统日期
'f1.write (FormatDateTime(Date, 2))
'收集网卡信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE AND DHCPEnabled = FALSE", , 48)
For Each objItem In colItems
' strhardwareinfo = strhardwareinfo & ("," & (objItem.Description) & "," & (objItem.MACAddress) & "," & (objItem.IPAddress(0)))
If Split(Trim(objItem.IPAddress(0)), ".")(0) = 10 Or Split(Trim(objItem.IPAddress(0)), ".")(0) = 133 Then
stripaddress = (Trim(objItem.IPAddress(0)))
strmacaddress = (objItem.MACAddress)
End If
Next

'收集计算机用户信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem", , 48)
For Each objItem In colItems
'strhardwareinfo = strhardwareinfo & ("," & (objItem.Manufacturer) & "," & (objItem.Model) & "," & Trim(objItem.Name))

If Not sh Is Nothing Then
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "Manufacturer"
.Cells(r, 5) = objItem.Manufacturer
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "Model"
.Cells(r, 5) = objItem.Model
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "userName"
.Cells(r, 5) = objItem.Name

End With
End If
Next
'收集CPU信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor", , 48)
For Each objItem In colItems
'strhardwareinfo = strhardwareinfo & ("," & Trim(objItem.Name))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "CPU"
.Cells(r, 5) = objItem.Name
End With
Next
'收集内存信息
'收集内存总容量
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem", , 48)
For Each objItem In colItems
' strhardwareinfo = strhardwareinfo & ("," & Trim(objItem.TotalPhysicalMemory))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "TotalPhysicalMemory"
.Cells(r, 5) = objItem.TotalPhysicalMemory
End With
Next
'收集硬盘基本信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive", , 48)
For Each objItem In colItems
' strhardwareinfo = strhardwareinfo & ("," & Trim(objItem.Caption) & "," & (objItem.Size))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "harddisk_Caption"
.Cells(r, 5) = objItem.Caption
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "harddisk_size"
.Cells(r, 5) = objItem.Size
End With
Next
'收集主板制造商和序列号信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_BaseBoard WHERE (Product IS NOT NULL)", , 48)
For Each objItem In colItems
' strhardwareinfo = strhardwareinfo & ("," & Trim(objItem.Manufacturer) & "," & Trim(objItem.SerialNumber))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "mainboard_Manufacturer"
.Cells(r, 5) = objItem.Manufacturer
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "mainboard_SerialNumber"
.Cells(r, 5) = objItem.SerialNumber
End With
Next
'收集显卡信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_VideoController", , 48)
For Each objItem In colItems
' strhardwareinfo = strhardwareinfo & ("," & Trim(objItem.Caption) & (objItem.VideoModeDescription))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "video_caption"
.Cells(r, 5) = objItem.Caption
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "VideoModeDescription"
.Cells(r, 5) = objItem.VideoModeDescription
End With
Next

'收集声卡信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_SoundDevice", , 48)
For Each objItem In colItems
' strhardwareinfo = strhardwareinfo & ("," & Trim(objItem.ProductName))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "radio_ProductName"
.Cells(r, 5) = Replace(objItem.ProductName, "'", "_")
End With
Next
'收集键盘信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Keyboard", , 48)
For Each objItem In colItems
' strhardwareinfo = strhardwareinfo & ("," & (objItem.DeviceID))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "keyboard_DeviceID"
.Cells(r, 5) = objItem.DeviceID
End With
Next
'收集鼠标信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PointingDevice", , 48)
For Each objItem In colItems
' strhardwareinfo = strhardwareinfo & ("," & (objItem.DeviceID))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "mouse_DeviceID"
.Cells(r, 5) = objItem.DeviceID
End With
Next
'收集网卡信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE AND DHCPEnabled = FALSE", , 48)
For Each objItem In colItems
' strhardwareinfo = strhardwareinfo & ("," & (objItem.Description) & "," & (objItem.MACAddress) & "," & (objItem.IPAddress(0)))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "network_Description"
.Cells(r, 5) = objItem.Description
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "network_MACAddress"
.Cells(r, 5) = objItem.MACAddress
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "network_IPAddress"
.Cells(r, 5) = objItem.IPAddress(0)
End With
'If Split(Trim(objItem.IPAddress(0)), ".")(0) = 10 Or Split(Trim(objItem.IPAddress(0)), ".")(0) = 133 Then
' strcomputername = (Trim(objItem.IPAddress(0)))
' End If
Next
'收集打印机信息
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Printer", , 48)
For Each objItem In colItems
'strhardwareinfo = strhardwareinfo & ("," & Trim(objItem.Name))
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = strdate
.Cells(r, 2) = stripaddress
.Cells(r, 3) = strmacaddress
.Cells(r, 4) = "Printer"
.Cells(r, 5) = objItem.Name
End With
Next
End If
Worksheets("硬件信息").Protect Password:="111111" '添加密码保护

End Sub

Public Sub commit_data()
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cnnStr As String, myTable As String, SQL As String, i As Integer, j As Integer, app_no As String
cnnStr = "Provider=MSDAORA;Data Source=zmdata1;User ID=crm;Password=zmdjf123;"

cnn.ConnectionString = cnnStr
cnn.Open
app_no = Worksheets("维修审核单").Cells(2, 1)
Set shyj = Worksheets("硬件信息")
'MsgBox shyj.Cells(2, 3)
SQL = "select * from ws_apply where app_no like '%" & app_no & "%'"
rs.CursorLocation = adUseClient '游标改为客户端游标
rs.Open Source:=SQL, ActiveConnection:=cnn
If rs.RecordCount < 1 Then
'添加维修申请单信息
For i = 2 To Range("a65536").End(xlUp).Row
SQL = "insert into ws_apply values('" & Cells(i, 1) & "','" & Cells(i, 2) & "','" & Cells(i, 3) & "','" & Cells(i, 4) & "','" & Cells(i, 5) & "','" & Cells(i, 6) & "','" & Cells(i, 7) & "','" & Cells(i, 8) & "','" & Cells(i, 9) & "')"
cnn.Execute SQL
Next i
'添加硬件信息
For i = 2 To shyj.Range("a65536").End(xlUp).Row
SQL = "insert into ws_hardwareinfo values('" & shyj.Cells(i, 1) & "','" & shyj.Cells(i, 2) & "','" & shyj.Cells(i, 3) & "','" & shyj.Cells(i, 4) & "','" & shyj.Cells(i, 5) & "')"
cnn.Execute SQL
Next i
Else
MsgBox "数据已添加过。"
End If
cnn.Close
End Sub