Solved

Trouble with VBScript retrieving Serial Numbers over network

Posted on 2010-08-19
17
530 Views
Last Modified: 2012-06-27
I have a VBScript that is supposed to take IP's from a text file and query the machine and return it's Computer Name, Model, and Service Tag/Serial Number in an Excel Document.

However, I'm returning an error on Line 75 and am hoping someone can help... Below is the entire code. Also If you look at the code around line 88-93 it says office 2003/office 2007 because there is a change in file names it saves it as. It saves it as .xls or something different. I don't think this is an issue though because it's erroring out before then.

I appreciate any help!! Thanks so much.
' text file to read from
 strReadFile = "C:\computers.txt"

 ' excel file to create
 sXLS = "C:\service tags.xls"  

 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objTS = objFSO.OpenTextFile(strReadFile)
 Set objShell = CreateObject("WScript.Shell")

 Set objExcel = CreateObject("Excel.Application")
	objExcel.Application.DisplayAlerts = False
	objExcel.Visible = True

 	objExcel.Workbooks.Add

	' define the column titles
    	objExcel.Cells(1,1).Value = "Computer Name"
    	objExcel.Cells(1,2).Value = "Model"
   	objExcel.Cells(1,3).Value = "Service Tag"

      	xRow = 1
      	yColumn = 1

	' apply styles to rows and columns
   	Do Until yColumn = 4
       		objExcel.Cells(xRow,yColumn).Font.Bold = True
    		objExcel.Cells(xRow,yColumn).Font.Size = 11
    		objExcel.Cells(xRow,yColumn).Interior.ColorIndex = 11 
    		objExcel.Cells(xRow,yColumn).Interior.Pattern = 1
    		objExcel.Cells(xRow,yColumn).Font.ColorIndex = 2
    		objExcel.Cells(xRow,yColumn).Borders.LineStyle = 1
    		objExcel.Cells(xRow,yColumn).WrapText = True
	yColumn = yColumn + 1
      	Loop

	x = 2
	y = 1

  ' start reading from the text file, until the end
  Do Until objTS.AtEndOfStream
    strComputer = objTS.ReadLine

		' check if the computername is pingbale, if not then skip to next name
		If (IsPingable(strComputer) = True) then
  		   Set objWMIService = GetObject("winmgmts:" _
			& "{impersonationLevel=impersonate}!\\" _
			& strComputer & "\root\cimv2")

			Set colComputer = objWMIService.ExecQuery _
				("SELECT * FROM Win32_ComputerSystemProduct","WQL",48)
			y1 = y

			If Err.number=0 Then
  				For Each objComputer in colComputer
      					objExcel.Cells(x,y1).Value = strComputer
      					y1 = y1 + 1 ' go to next column
      					objExcel.Cells(x,y1).Value = objComputer.Name
      					y1 = y1 + 1 ' go to next column
      					objExcel.Cells(x,y1).Value = objComputer.IdentifyingNumber
      					x = x + 1 ' go to the next Row
				Next

			Else
      					objExcel.Cells(x,y1).Value = strComputer
      					y1 = y1 + 1 ' go to next column
      					objExcel.Cells(x,y1).Value = "Model not found!"
      					y1 = y1 + 1 ' go to next column
      					objExcel.Cells(x,y1).Value = "Serial not found!"
      					x = x + 1 ' go to the next Row
			End If
			Err.clear

		Else
      			objExcel.Cells(x,y1).Value = strComputer
      			y1 = y1 + 1 ' go to next column
      			objExcel.Cells(x,y1).Value = "Not Pingable"
      			x = x + 1 ' go to the next Row
			
  	    	End If
   Loop

 objExcel.Columns("A:C").Select
 objExcel.Selection.HorizontalAlignment = 3 	'center all data
 objExcel.Selection.Borders.LineStyle = 1 	'apply borders
 objExcel.Columns("A:AH").EntireColumn.AutoFit  'autofit all columns

 appVerInt = split(objExcel.Version, ".")(0)
	If appVerInt-Excel2007 >=0 Then
  	    objExcel.ActiveWorkbook.SaveAs(sXLS), 56  'office 2007
	Else
  	    objExcel.ActiveWorkbook.SaveAs(sXLS), 43  'office 2003
	End If

 objExcel.Quit

 set objExcel = Nothing
 objTS.Close


msgbox "Done!"
WScript.Quit


Function IsPingable(ByVal strHost)
  If Trim(strHost) <> "" Then
     strCommand = "Ping.exe -n 3 -w 750 " & strHost
     Set objExecObject = objShell.Exec _
        ("%comspec% /c title " & strHost _
        & chr(38) & strCommand)
     Do While Not objExecObject.StdOut.AtEndOfStream
        strText = objExecObject.StdOut.ReadLine()
        If Instr(strText, "TTL=") > 0 _
          Then IsPingable = True : Exit Do
     Loop
     If IsPingable = True then
        With GetObject("winmgmts:root\cimv2")
           For Each objProcess in .ExecQuery _
              ("SELECT commandline FROM Win32_Process" _
              & " WHERE Name = 'ping.exe'",,48)
              If objProcess.commandline = strCommand _
                Then objProcess.Terminate() : Exit For
           Next
        End With
     End If
  End If
  If (not IsPingable = True) Then IsPingable = False
End Function

Open in new window

0
Comment
Question by:keith_opswat
  • 6
  • 5
  • 4
  • +1
17 Comments
 
LVL 17

Expert Comment

by:calacuccia
ID: 33476904
How does the strComputer variable (string I guess) look like when the error is raised?
What is the error message?
0
 
LVL 13

Expert Comment

by:MWGainesJR
ID: 33477699
This line:
objExcel.Cells(x,y1).Value = strComputer
is not fully qualified with a sheetname
should be:

 objExcel.sheets(1).cells(x,y1).value = strComputer
0
 
LVL 13

Expert Comment

by:MWGainesJR
ID: 33477773
Correction....I was thinking objexcel was a workbook....
you need this
dim objexcel as object
dim wb as object
dim ws as object
set objexcel = createobject("Excel.Application")
set wb = objexcel.workbooks.add
set ws = wb.sheets(1)
ws.cells(x,y1).value = strComputer
0
 
LVL 13

Expert Comment

by:MWGainesJR
ID: 33477872
this test code worked for me like a charm....


dim objexcel
dim wb
dim ws
set objexcel = createobject("Excel.Application")
objexcel.visible = true
set wb = objexcel.workbooks.add
set ws = wb.sheets(1)
ws.range("A1").value = "Hello"
0
 
LVL 4

Author Comment

by:keith_opswat
ID: 33478540
So which code should I use and I replace line 75 with that code?

Thanks a lot for your quick repsonse.
0
 
LVL 13

Expert Comment

by:MWGainesJR
ID: 33478737
post all of your code, and I'll fix it......the code above doesn't have your declarations.
0
 
LVL 13

Expert Comment

by:MWGainesJR
ID: 33478811
nevermind see if this will work for you.

' text file to read from  

 strReadFile = "C:\computers.txt"  

  

 ' excel file to create  

 sXLS = "C:\service tags.xls"    

  

 Set objFSO = CreateObject("Scripting.FileSystemObject")  

 Set objTS = objFSO.OpenTextFile(strReadFile)  

 Set objShell = CreateObject("WScript.Shell")  

  

 Set objExcel = CreateObject("Excel.Application") 

        objExcel.Application.DisplayAlerts = False  

        objExcel.Visible = True  

 Set wb = objExcel.workbooks.add

 Set ws = wb.sheets(1) 



  

        ' define the column titles  

        ws.Cells(1,1).Value = "Computer Name"  

        ws.Cells(1,2).Value = "Model"  

        ws.Cells(1,3).Value = "Service Tag"  

  

        xRow = 1  

        yColumn = 1  

  

        ' apply styles to rows and columns  

        Do Until yColumn = 4  

                ws.Cells(xRow,yColumn).Font.Bold = True  

                ws.Cells(xRow,yColumn).Font.Size = 11  

                ws.Cells(xRow,yColumn).Interior.ColorIndex = 11   

                ws.Cells(xRow,yColumn).Interior.Pattern = 1  

                ws.Cells(xRow,yColumn).Font.ColorIndex = 2  

                ws.Cells(xRow,yColumn).Borders.LineStyle = 1  

                ws.Cells(xRow,yColumn).WrapText = True  

        yColumn = yColumn + 1  

        Loop  

  

        x = 2  

        y = 1  

  

  ' start reading from the text file, until the end  

  Do Until objTS.AtEndOfStream  

    strComputer = objTS.ReadLine  

  

                ' check if the computername is pingbale, if not then skip to next name  

                If (IsPingable(strComputer) = True) then  

                   Set objWMIService = GetObject("winmgmts:" _  

                        & "{impersonationLevel=impersonate}!\\" _  

                        & strComputer & "\root\cimv2")  

  

                        Set colComputer = objWMIService.ExecQuery _  

                                ("SELECT * FROM Win32_ComputerSystemProduct","WQL",48)  

                        y1 = y  

  

                        If Err.number=0 Then  

                                For Each objComputer in colComputer  

                                        ws.Cells(x,y1).Value = strComputer  

                                        y1 = y1 + 1 ' go to next column  

                                        ws.Cells(x,y1).Value = objComputer.Name  

                                        y1 = y1 + 1 ' go to next column  

                                        ws.Cells(x,y1).Value = objComputer.IdentifyingNumber  

                                        x = x + 1 ' go to the next Row  

                                Next  

  

                        Else  

                                        ws.Cells(x,y1).Value = strComputer  

                                        y1 = y1 + 1 ' go to next column  

                                        ws.Cells(x,y1).Value = "Model not found!"  

                                        y1 = y1 + 1 ' go to next column  

                                        ws.Cells(x,y1).Value = "Serial not found!"  

                                        x = x + 1 ' go to the next Row  

                        End If  

                        Err.clear  

  

                Else  

                        ws.Cells(x,y1).Value = strComputer  

                        y1 = y1 + 1 ' go to next column  

                        ws.Cells(x,y1).Value = "Not Pingable"  

                        x = x + 1 ' go to the next Row  

                          

                End If  

   Loop  

  

 

 ws.Columns("A:C").HorizontalAlignment = 3     'center all data  

 ws.Columns("A:C").Borders.LineStyle = 1       'apply borders  

 ws.Columns("A:AH").EntireColumn.AutoFit  'autofit all columns  

  

 appVerInt = split(objExcel.Version, ".")(0)  

        If appVerInt-Excel2007 >=0 Then  

            objExcel.ActiveWorkbook.SaveAs(sXLS), 56  'office 2007  

        Else  

            objExcel.ActiveWorkbook.SaveAs(sXLS), 43  'office 2003  

        End If  

  

 objExcel.Quit  

  

 set objExcel = Nothing  

 objTS.Close  

  

  

msgbox "Done!"  

WScript.Quit  

  

  

Function IsPingable(ByVal strHost)  

  If Trim(strHost) <> "" Then  

     strCommand = "Ping.exe -n 3 -w 750 " & strHost  

     Set objExecObject = objShell.Exec _  

        ("%comspec% /c title " & strHost _  

        & chr(38) & strCommand)  

     Do While Not objExecObject.StdOut.AtEndOfStream  

        strText = objExecObject.StdOut.ReadLine()  

        If Instr(strText, "TTL=") > 0 _  

          Then IsPingable = True : Exit Do  

     Loop  

     If IsPingable = True then  

        With GetObject("winmgmts:root\cimv2")  

           For Each objProcess in .ExecQuery _  

              ("SELECT commandline FROM Win32_Process" _  

              & " WHERE Name = 'ping.exe'",,48)  

              If objProcess.commandline = strCommand _  

                Then objProcess.Terminate() : Exit For  

           Next  

        End With  

     End If  

  End If  

  If (not IsPingable = True) Then IsPingable = False  

End Function

Open in new window

0
 
LVL 17

Expert Comment

by:calacuccia
ID: 33479221
If this was the problem, wouldn't it hit on Line 18 already?

18        objExcel.Cells(1,1).Value = "Computer Name"
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 17

Expert Comment

by:calacuccia
ID: 33479238
Regardless of that comment, of course, the Worksheet object creation is absolutely necessary.
0
 
LVL 4

Author Comment

by:keith_opswat
ID: 33479748
It's still erroring line 76... Same code. Here's the full error box.

It pops up the Excel document with Computer name in column A, Model in Column B, and Service Tag in Column C.

Error message:

Windows Script Host

Script:         C:\Users...etc etc
Line:           76
Char:           25
Error:          Unknown Runtime Error
Code:          800A03EC
Source:       Microsoft VBScript runtime Error

I tried looking this up but didn't find anything too useful.
0
 
LVL 13

Expert Comment

by:MWGainesJR
ID: 33479814
can you upload your vbs file?
0
 
LVL 4

Author Comment

by:keith_opswat
ID: 33479836
Sure.. Here it is. Thanks a lot for your time. You're definitely earning these points.
serialtoexcel.vbs
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 33480434
Hi, you're problem is that in line 75, you use y1 as a cell reference
          objExcel.Cells(x,y1).Value = strComputer
BUT, y1 has no value because it is only assigned when a machine is online, and will be treated as zero, causing the error as a cell reference.
So, if you move this line
   y1 = y

To above this line
  If (IsPingable(strComputer) = True) Then
then y1 will always have a value.
Regards,
Rob.
0
 
LVL 17

Expert Comment

by:calacuccia
ID: 33480608
Well spotted
0
 
LVL 4

Author Comment

by:keith_opswat
ID: 33480651
It worked!!! Points go to Rob Sampson!!! It works but I was going down a list of IP's and I was returned another error message for something else a few IP's in. It had a problem with the 2nd line of code saying it couldn't get or open object.
[code]
            y1 = y
            If (IsPingable(strComputer) = True) then
                 Set objWMIService = GetObject("winmgmts:" _
                  & "{impersonationLevel=impersonate}!\\" _
                  & strComputer & "\root\cimv2")
[/code]

However, the problem I posted is fixed and it does work. So if I have any more issues I'll post a new question. If you know what was wrong with that off the top of your head though that'd be great.

Thanks everyone for all your help!!
0
 
LVL 4

Author Closing Comment

by:keith_opswat
ID: 33480656
Thanks so much for the help!
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33480832

Thanks for the grade.
As for the next error, when the GetObject call fails, despite the fact a machine is online, then there is either a permissions issue with that particular remote computer, or WMI is not working correctly.&nbsp; To get around that for now, you need to use error checking on that, as in

                  On Error Resume Next
                  Set objWMIService = GetObject("winmgmts:" _
                  & "{impersonationLevel=impersonate}!\\" _
                  & strComputer & "\root\cimv2")
                  If Err.Number = 0 Then
                                    On Error GoTo 0
                                    ' Continue with the rest of your code
                  Else
                                    On Error GoTo 0
                                    objExcel.Cells(x,y1).Value = strComputer
                                    y1 = y1 + 1 ' go to next column
                                    objExcel.Cells(x,y1).Value = "WMI Error"
                                    x = x + 1 ' go to the next Row
                                    Err.Clear
                  End If


Regards,

Rob.
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now