WMI return not showing incorrect results

[tsetsu]

Attempting to get some information from a WMI query but it keeps returning incorrect results. I use this kind of script for a few things and yet to figure out why it does this. I figured out part of the problem is that when it can not query that computer is just uses the last good return as the result. I want it to return either a null result or show me something saying it did not return rather then just the last good result. If you are admin and run this on your system you will see what I am saying. I am not concerned about the PCs that will not return, I can figure those out in the future when they do not return. let me know if have any ideas or advice. Thank you.
I attempted to comment the code as much as possible to help people read it

'--------------Cbrand.vbs

'header---------------------------------------------------------------------------------------------------------------------------------------------
on error resume next


'AD request var for reference
Dim objRootDSE, adoCommand, adoConnection, strDNSDomain
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
'AD work field
Dim strNTName
'excel reference
Dim objExcel, objWorkbook
'WMI referenc
Dim Prod, ComV, colv, wmiquery, objwmi, wmiroot, strcomputer, Computer
'other var
Dim aMachines, i, T




'reference Information------------------------------------------------------------------------------------------------------------------------
'AD request----start
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on requesting place object. fill in "computer"
strFilter = "(objectCategory=computer)"
' Comma delimited list of attributes.
strAttributes = "sAMAccountName"
' Construct LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
' Execute the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
'AD request----end



'build an excel app----start
Set objExcel = CreateObject("Excel.Application")'create the excel file
Set objWorkbook = objExcel.Workbooks.Open("C:\Documents and Settings\thuffman.HHGREGG\Desktop\TEST\computer\test.xls") 'file lication
objExcel.Visible = True 'True -if you want to see it run. False to run in background.
objExcel.Cells(1, 1).Value = "computer name" 'cell values
objExcel.Cells(1, 2).Value = "computer system product"
objExcel.Cells(1, 3).Value = "model"
objExcel.Cells(1, 4).Value = "manufacturer"
objExcel.cells(1, 5).Value = "value"
'build an excel app----end
'set variables
i=2

'worker---------------------------------------------------------------------------------------------------------------------------------------------

Do Until adoRecordset.EOF ' loop through till there are no more items in list
strNTName = adoRecordset.Fields("sAMAccountName").Value 'items to query in AD

aMachines = split(Left(strNTName,Len(strNTName)-1), ";") 'remove the final character off of the return $ is added to values in AD

for each Computer in aMachines
'Wmi reference----start
wmiroot = "winmgmts:\\" & Computer & "\root\cimv2"
set objwmi = Getobject(wmiroot)
wmiquery = "select * from Win32_ComputerSystemProduct"
set colv = objwmi.execQuery (wmiQuery)
'Wmi reference----end







'output-----------------------------------------------------------------------------------------------------------------------------------------------


for each ComV in colv
T=1 'CELL A
objExcel.Cells(i, T).Value = Computer
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12
T=T+1 'CELL B
objExcel.Cells(i, T).Value = (ComV.Name)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12


next ' for each ComV in colv


next 'for each computer in aMachines
'WMI reference -------- start
for each Computer in aMachines
wmiroot = "winmgmts:\\" & Computer & "\root\cimv2"
wmiquery = "select * from Win32_SystemEnclosure"
set colsnnm = objwmi.execQuery (wmiQuery)
'WMI reference -------- end
for each item in colsnnm
T=T+1 'CELL C
objExcel.Cells(i, T).Value = (item.model)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

T=T+1
objExcel.Cells(i, T).Value = (item.manufacturer)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12
next 'for each item in colsnnm
next 'for each computer in aMachines
i=i+1 ' increase cells by 1 for loops
adoRecordset.MoveNext 'move to next item in AD before loop
loop 'loop do until adoRecordset.EOF
'functions and subs-------------------------------------------------------------------------------------------------------------------------------

'close-------------------------------------------------------------------------------------------------------------------------------------------------

objExcel.Workbooks(1).Save 'Save the workbook, not excel file
objExcel.Workbooks(1).close 'close the workbook
objexcel.quit 'close excel file.

adoRecordset.Close ' close your query
adoConnection.Close

' Clean up.
Set objRootDSE = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing
Set adoRecordset = Nothing

'echo to know it is finished
wscript.echo "finished

 

[PHV]

...
for each Computer in aMachines
wmiroot = "winmgmts:\\" & Computer & "\root\cimv2"
[!]set objwmi = Getobject(wmiroot)[/!]
wmiquery = "select * from Win32_SystemEnclosure"
set colsnnm = objwmi.execQuery (wmiQuery)
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[tsetsuit]

set objwmi = Getobject(wmiroot)
is already set higher in the page and I never closed it out so I should not have to set it again but I did try it out same results. just as an example to get what it is doing.

computer name Model comment
Computer1 Lenovo This is correct
Computer2 Lenovo This is incorrect
Computer3 Lenovo This is incorrect
Computer4 HP 6510b This is correct
Computer5 HP 6510b This is incorrect

what it is doing on computer 2 3 and 5 is taking last good value and putting in that value sometimes rather then the correct value. I thought it was just on PCs it can not query but I found some PCs that I do a single query on and I get the correct results. not really that sure why it is doing this. Will work with it more let me know if anyone has any ideas.

 

[tsuji]

Why do you put "on error resume next" at the top? that's null to proper scripting.

 

[PHV]

...
for each Computer in aMachines
wmiroot = "winmgmts:\\" & Computer & "\root\cimv2"
Err.Clear
set objwmi = Getobject(wmiroot)
If Err.Number = 0 Then
wmiquery = "select * from Win32_SystemEnclosure"
set colsnnm = objwmi.execQuery (wmiQuery)
...
End If
next 'for each computer in aMachines
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[tsetsuit]

I have on error resume next at the top because first 25 things this query hits are servers and it will prompt with a "access denied".
I did a
if computer.name = "computer name array" then
next
else
run script
end if

didn't want to list all my servers in this script on the net so I left it with a on error resume next at top. I usually do an on error resume next and input a e-mail prompt because I am not the only one using this. Just have it e-mail me if there is a problem and what computer it is coming from. Most users I have using this kind of script would just use it to find information from AD or some database i have it bound to.

 

[tsuji]

Then why do you complain incorrect results? and provision no measure trapping error?

 

[tsetsuit]

for each Computer in aMachines
wmiroot = "winmgmts:\\" & Computer & "\root\cimv2"
Err.Clear
set objwmi = Getobject(wmiroot)
If Err.Number <> 0 Then
wscript.echo err.number
else
wmiquery = "select * from Win32_SystemEnclosure"
set colsnnm = objwmi.execQuery (wmiQuery)

'WMI reference -------- end
for each item in colsnnm
T=T+1 'CELL C
objExcel.Cells(i, T).Value = (item.model)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

T=T+1
objExcel.Cells(i, T).Value = (item.manufacturer)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12
next 'for each item in colsnnm

end if 'if err.number = 0 then
next 'for each computer in aMachines
i=i+1 ' increase cells by 1 for loops
adoRecordset.MoveNext 'move to next item in AD before loop
loop 'loop do until adoRecordset.EOF



getting it to post a 462 which is machine is not available which i know is the problem i just don't know why it is duplicating the previous data into that field and not leaving it blank. I will just put an error catch in for 462 and have it bypass if that shows up. my question this whole time is why is it pulling back this duplicate data and not just leaving a blank space.

 

[tsetsuit]

oh and thank you PHV for your assitance.

 

[hannable80]

Hi,

Would it be possible for you to put the full code up for this . working on the same problem

 

[tsetsuit]

To be honest hannable80 I still don't have a resolve for this. I keep getting error codes back on systems I should not get that error from. I don't have the full code on me right now, it is on my flash drive I left at work. I will post what I have come up with so far tomorrow and just so you can receive the error codes but that has not fixed it yet. Still not sure why it returns these results because I can run this whole script and get that problem but I can run a separate script that just runs on 1 computer and get correct results when this script gives me something incorrect.

Here is a bit of info
Running on windows XP SP2 environment.
Windows 2003 server for AD query
Looks like all COM object and settings are correct.

 

[hannable80]

Its a strange one alright i do my best

 

[tsetsuit]

Ok I didn't go into work today, still sick so I just rebuilt it like I have it on my flash drive at work. I can't test it right now because I am fixing my VPN connection which I am sick and not to motivated to do that. So you can test this. It should post all the error codes in the excel workbook so you can debug some of them. Let me know if you come up with anything. I am still working on it myself but I have to finish this script in PHP for a website I am working on to get all their Mysql database viewable on web before I can sit back down with it.



'--------------Cbrand.vbs

'header---------------------------------------------------------------------------------------------------------------------------------------------
on error resume next


'AD request var for reference
Dim objRootDSE, adoCommand, adoConnection, strDNSDomain
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
'AD work field
Dim strNTName
'excel reference
Dim objExcel, objWorkbook
'WMI referenc
Dim Prod, ComV, colv, wmiquery, objwmi, wmiroot, strcomputer, Computer
'other var
Dim aMachines, i, T




'reference Information------------------------------------------------------------------------------------------------------------------------
'AD request----start
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on requesting place object. fill in "computer"
strFilter = "(objectCategory=computer)"
' Comma delimited list of attributes.
strAttributes = "sAMAccountName"
' Construct LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
' Execute the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
'AD request----end



'build an excel app----start
Set objExcel = CreateObject("Excel.Application")'create the excel file
Set objWorkbook = objExcel.Workbooks.Open("C:\Documents and Settings\thuffman.HHGREGG\Desktop\TEST\computer\test.xls") 'file lication
objExcel.Visible = True 'True -if you want to see it run. False to run in background.
objExcel.Cells(1, 1).Value = "computer name" 'cell values
objExcel.Cells(1, 2).Value = "computer system product"
objExcel.Cells(1, 3).Value = "model"
objExcel.Cells(1, 4).Value = "manufacturer"
objExcel.cells(1, 5).Value = "value"
'build an excel app----end
'set variables
i=2

'worker---------------------------------------------------------------------------------------------------------------------------------------------

Do Until adoRecordset.EOF ' loop through till there are no more items in list
strNTName = adoRecordset.Fields("sAMAccountName").Value 'items to query in AD

aMachines = split(Left(strNTName,Len(strNTName)-1), ";") 'remove the final character off of the return $ is added to values in AD

for each Computer in aMachines
'Wmi reference----start
wmiroot = "winmgmts:\\" & Computer & "\root\cimv2"
Err.Clear
set objwmi = Getobject(wmiroot)
If Err.Number <> 0 Then


for each ComV in colv
T=1 'CELL A
objExcel.Cells(i, T).Value = Computer
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12
T=T+1 'CELL B
objExcel.Cells(i, T).Value = err.number
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12


next ' for each ComV in colv

else
wmiquery = "select * from Win32_ComputerSystemProduct"
set colv = objwmi.execQuery (wmiQuery)
'Wmi reference----end

'output-----------------------------------------------------------------------------------------------------------------------------------------------


for each ComV in colv
T=1 'CELL A
objExcel.Cells(i, T).Value = Computer
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12
T=T+1 'CELL B
objExcel.Cells(i, T).Value = (ComV.Name)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12


next ' for each ComV in colv

end if 'if error.number <> 0 then

next 'for each computer in aMachines



for each Computer in aMachines
wmiroot = "winmgmts:\\" & Computer & "\root\cimv2"
Err.Clear
set objwmi = Getobject(wmiroot)
If Err.Number <> 0 Then

for each item in colsnnm
T=T+1
objExcel.Cells(i, T).Value = err.number
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

next 'for each item in colsnnm

else
wmiquery = "select * from Win32_SystemEnclosure"
set colsnnm = objwmi.execQuery (wmiQuery)

'WMI reference -------- end
for each item in colsnnm

T=T+1
objExcel.Cells(i, T).Value = (item.manufacturer)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12
next 'for each item in colsnnm

end if 'if err.number <> 0 then
next 'for each computer in aMachines
i=i+1 ' increase cells by 1 for loops
adoRecordset.MoveNext 'move to next item in AD before loop
loop 'loop do until adoRecordset.EOF
'functions and subs-------------------------------------------------------------------------------------------------------------------------------

'close-------------------------------------------------------------------------------------------------------------------------------------------------

objExcel.Workbooks(1).Save 'Save the workbook, not excel file
objExcel.Workbooks(1).close 'close the workbook
objexcel.quit 'close excel file.

adoRecordset.Close ' close your query
adoConnection.Close

' Clean up.
Set objRootDSE = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing
Set adoRecordset = Nothing

'echo to know it is finished
wscript.echo "finished"

 

[tsetsuit]

update on info. found a fix. some reason it doesn't like it when assign variables to the query strings. I changed the code to what is listed below and everything is running smooth now. no idea why it didn't like the variable for the query string. All the errors I get are as they should be now and all the information is pulling back correct information. All I need to do is change the WMI query string to what I am looking for and should work fine.


'-----------------------

'header---------------------------------------------------------------------------------------------------------------------------------------------
on error resume next


'AD request var for reference
Dim objRootDSE, adoCommand, adoConnection, strDNSDomain
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
'AD work field
Dim strNTName
'excel reference
Dim objExcel, objWorkbook
'WMI referenc
Dim Prod, ComV, colv, wmiquery, objwmi, wmiroot, strcomputer, Computer
'other var
Dim aMachines, i, T




'reference Information------------------------------------------------------------------------------------------------------------------------
'AD request----start
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on requesting place object. fill in "computer"
strFilter = "(objectCategory=computer)"
' Comma delimited list of attributes.
strAttributes = "sAMAccountName"
' Construct LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
' Execute the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
'AD request----end



'build an excel app----start
Set objExcel = CreateObject("Excel.Application")'create the excel file
Set objWorkbook = objExcel.Workbooks.Open("C:\Documents and Settings\thuffman.HHGREGG\Desktop\TEST\computer\test.xls") 'file lication
objExcel.Visible = True 'True -if you want to see it run. False to run in background.
objExcel.Cells(1, 1).Value = "computer name" 'cell values
objExcel.Cells(1, 2).Value = "computer system product"
objExcel.Cells(1, 3).Value = "RAM"
objExcel.cells(1, 4).Value = "--"
'build an excel app----end
'set variables
i=2

'worker---------------------------------------------------------------------------------------------------------------------------------------------

Do Until adoRecordset.EOF ' loop through till there are no more items in list
strNTName = adoRecordset.Fields("sAMAccountName").Value 'items to query in AD

aMachines = split(Left(strNTName,Len(strNTName)-1), ";") 'remove the final character off of the return $ is added to values in AD

for each Computer in aMachines
'Wmi reference----start
err.clear
Set objWMIService = GetObject("winmgmts:\\" & Computer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process")

if err.number <> 0 then
'Wmi reference----end

'output-----------------------------------------------------------------------------------------------------------------------------------------------

for each ComV in colprocesses
T=1 'CELL A
objExcel.Cells(i, T).Value = Computer
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

T=T+1 'CELL B
objExcel.Cells(i, T).Value = err.number
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

next ' for each ComV in colv
else

for each ComV in colprocesses
T=1 'CELL A
objExcel.Cells(i, T).Value = Computer
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

T=T+1 'CELL B
objExcel.Cells(i, T).Value = (ComV.Name)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12


next ' for each ComV in colv
end if ' if err.number <> 0 then

next 'for each computer in aMachines

'***************************************
'********************split**************
'***************************************
'WMI reference -------- start
for each Computer in aMachines

err.clear
set objWMIService = GetObject("winmgmts:\\" & Computer & "\root\cimv2")
set colbrand = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct")

If Err.Number <> 0 Then

for each item in colbrand

T=T+1


objExcel.Cells(i, T).Value = err.number
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

next 'for each item in colsnnm
else


'WMI reference -------- end
for each item in colbrand

T=T+1
objExcel.Cells(i, T).Value = (item.name)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

next 'for each item in colsnnm
end if 'if err.number = 0 then

next 'for each computer in aMachines
i=i+1 ' increase cells by 1 for loops
adoRecordset.MoveNext 'move to next item in AD before loop
loop 'loop do until adoRecordset.EOF
'functions and subs-------------------------------------------------------------------------------------------------------------------------------

'close-------------------------------------------------------------------------------------------------------------------------------------------------

objExcel.Workbooks(1).Save 'Save the workbook, not excel file
objExcel.Workbooks(1).close 'close the workbook
objexcel.quit 'close excel file.

adoRecordset.Close ' close your query
adoConnection.Close

' Clean up.
Set objRootDSE = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing
Set adoRecordset = Nothing

'echo to know it is finished
wscript.echo "finished

 

[hannable80]

This script works great better than my one. I am having a problem finding the service tag and amount of ram in the machine. I have butchered your code to no great effect all i get is the same amount of ram again and again.....



Can you show me where i am going wrong



Option Explicit
Sub auto_open()

Dim i As Integer

Dim contracts(2000) As Variant
Dim contractsEmpty(2000) As Variant
Dim contractsExpired(2000) As Variant
Dim contractString As String
Dim contractStringEmpty As String
Dim contractStringExpired As String

Sheets("VBA Sheet").Activate

i = 4

Do While IsEmpty(Cells(i, 3)) = False

If IsEmpty(Cells(i, 7)) = False And ((Cells(i, 7).Value - Date) < 90) Then
contracts(i - 3) = Cells(i, 3).Value
contractString = contractString & vbCrLf & "Contract(No. " & Cells(i, 2).Value & ")" & vbTab & contracts(i - 3)
End If

If IsEmpty(Cells(i, 7)) = False And ((Date - Cells(i, 7).Value) > 0) Then
contractsExpired(i - 3) = Cells(i, 3).Value
contractStringExpired = contractStringExpired & vbCrLf & "Contract(No. " & Cells(i, 2).Value & ")" & vbTab & contractsExpired(i - 3)
End If

If IsEmpty(Cells(i, 7)) Then
contractsEmpty(i - 3) = Cells(i, 3).Value
contractStringEmpty = contractStringEmpty & vbCrLf & "Contract(No. " & Cells(i, 2).Value & ")" & vbTab & contractsEmpty(i - 3)
End If

i = i + 1
Loop

MsgBox "Expire contract:" & vbLf & vbTab & contractString, vbInformation, "Please Note!"
MsgBox "Contracts expired:" & vbLf & vbTab & contractStringExpired, vbInformation, "Please Note!"
MsgBox "No Expire Date available:" & vbLf & vbTab & contractStringEmpty, vbInformation, "Notice"

End Sub

 

[markdmac]

Just a few comments, I see you have things working however you have some cleanup to the code that you could do.

You are performing multiple binds to the same PC:
set objWMIService = GetObject("winmgmts:\\" & Computer & "\root\cimv2")

There is no reason for this. You also aren't really performing error checking.

Here is a suggestion how to handle it after you enumerate the PCs.

For each Computer in aMachines
	Err.Clear
	'Bind to the computer
	Set objWMIService = GetObject("winmgmts:\\" & Computer & "\root\cimv2")
	If Err.Number = 0 Then
		'Code to execute if successful
		'You have already connected to CIMV2 on the PC and can make multiple queries to it.
		Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process")
		Set colbrand = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct")
		'Populate excel code goes here
		
		'move out of the IF statement and increment the row counter
				
	Else
		'Do nothing
		'move out of the IF statement and increment the row counter
		
	End If
	i = i + 1
Next

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[hannable80]

oops posted the wrong code...

so what happens is that the code dumps the same amount of ram to each machine. Its not iterating down.
'-----------------------

'header---------------------------------------------------------------------------------------------------------------------------------------------
on error resume next


'AD request var for reference
Dim objRootDSE, adoCommand, adoConnection, strDNSDomain
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
'AD work field
Dim strNTName
'excel reference
Dim objExcel, objWorkbook
'WMI referenc
Dim Prod, ComV, colv, wmiquery, objwmi, wmiroot, strcomputer, Computer
'other var
Dim aMachines, i, T




'reference Information------------------------------------------------------------------------------------------------------------------------
'AD request----start
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on requesting place object. fill in "computer"
strFilter = "(objectCategory=computer)"
' Comma delimited list of attributes.
strAttributes = "sAMAccountName"
' Construct LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
' Execute the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
'AD request----end



'build an excel app----start
Set objExcel = CreateObject("Excel.Application")'create the excel file
Set objWorkbook = objExcel.Workbooks.Open("C:\") 'file lication
objExcel.Visible = True 'True -if you want to see it run. False to run in background.
objExcel.Cells(1, 1).Value = "computer name" 'cell values
objExcel.Cells(1, 2).Value = "computer system product"
objExcel.Cells(1, 3).Value = "RAM"
objExcel.cells(1, 4).Value = "--"
'build an excel app----end
'set variables
i=2

'worker---------------------------------------------------------------------------------------------------------------------------------------------

Do Until adoRecordset.EOF ' loop through till there are no more items in list
strNTName = adoRecordset.Fields("sAMAccountName").Value 'items to query in AD

aMachines = split(Left(strNTName,Len(strNTName)-1), ";") 'remove the final character off of the return $ is added to values in AD

for each Computer in aMachines
'Wmi reference----start
err.clear
Set objWMIService = GetObject("winmgmts:\\" & Computer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process")



if err.number <> 0 then


'Wmi reference----end

'output-----------------------------------------------------------------------------------------------------------------------------------------------

for each ComV in colprocesses
T=1 'CELL A
objExcel.Cells(i, T).Value = Computer
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

T=T+1 'CELL B
objExcel.Cells(i, T).Value = err.number
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

next ' for each ComV in colv
else

for each ComV in colprocesses
T=1 'CELL A
objExcel.Cells(i, T).Value = Computer
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

T=T+1 'CELL B
objExcel.Cells(i, T).Value = (ComV.Name)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12


next ' for each ComV in colv

For Each wbemObject In wbemObjectSet
T=6 'CELL A
objExcel.Cells(i, T).Value = (wbemObject.TotalPhysicalMemory)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

'T=T+1 'CELL B
'objExcel.Cells(i, T).Value = (wbemObject.TotalPhysicalMemory)
'objExcel.Cells(i, T).Font.Bold = TRUE
'objExcel.Cells(i, T).Interior.ColorIndex = 0
'objExcel.Cells(i, T).Font.ColorIndex = 1
'objexcel.cells(i, T).font.size = 12
next

end if ' if err.number <> 0 then

next 'for each computer in aMachines

'***************************************
'********************split**************
'***************************************
'WMI reference -------- start
for each Computer in aMachines

err.clear
set objWMIService = GetObject("winmgmts:\\" & Computer & "\root\cimv2")
set colbrand = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct")

If Err.Number <> 0 Then

for each item in colbrand

T=T+1


objExcel.Cells(i, T).Value = err.number
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

next 'for each item in colsnnm
else


'WMI reference -------- end
for each item in colbrand

T=T+1
objExcel.Cells(i, T).Value = (item.name)
objExcel.Cells(i, T).Font.Bold = TRUE
objExcel.Cells(i, T).Interior.ColorIndex = 0
objExcel.Cells(i, T).Font.ColorIndex = 1
objexcel.cells(i, T).font.size = 12

next 'for each item in colsnnm
end if 'if err.number = 0 then
Set wbemServices = GetObject("winmgmts:\\" & strComputer)
Set wbemObjectSet = wbemServices.InstancesOf("Win32_LogicalMemoryConfiguration")' here is where the prob is

If Err.Number <> 0 Then
For Each wbemObject In wbemObjectSet
T=T+1
d

next 'for each computer in aMachines
i=i+1 ' increase cells by 1 for loops
adoRecordset.MoveNext 'move to next item in AD before loop
loop 'loop do until adoRecordset.EOF
'functions and subs-------------------------------------------------------------------------------------------------------------------------------

'close-------------------------------------------------------------------------------------------------------------------------------------------------

objExcel.Workbooks(1).Save 'Save the workbook, not excel file
objExcel.Workbooks(1).close 'close the workbook
objexcel.quit 'close excel file.

adoRecordset.Close ' close your query
adoConnection.Close

' Clean up.
Set objRootDSE = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing
Set adoRecordset = Nothing

'echo to know it is finished
wscript.echo "finished"

 

[markdmac]

Try using the code I posted.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.