Re: VBScript and Out Put to Excel Worksheet

Tech-Archive recommends: Fix windows errors by optimizing your registry

Hi,

The spread*** object is created in Sub Checkit. Sub Checkit is called once
for each computer name read from the text file. The code to setup the
spread*** should be in the main part of the script, not in the Sub. Any
objects instantiated in the main part of the script (such as objExcel and
objWork***) will have global scope and be available in the Subs.

--
Richard
Microsoft MVP Scripting and ADSI
Hilltop Lab web site - http://www.rlmueller.net
--
"MFelkins" <MFelkins@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:69D5B880-BD14-4240-BD6D-2B451116091E@xxxxxxxxxxxxxxxx
> Well, that was fun. The first two machines on my list did not have WMI. I
> removed them from the list and now the script works. Here is the fun part.
It
> opens up a new Spread*** for each server in the list. I am sure it has
to
> do with the Do Loop, but I don't see how add to the open ***.
>
> My code so far:
>
> '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
> 'On Error Resume Next
> Dim Message, result
> Dim strComputer, strDN
> Dim objShell, objFSO, strTemp, strTempFile
> Dim objRecordSet, strAttributes
> Dim objRemote, intRow, strRole
> Dim strExcelPath, objExcel, obj***, intCol
> Dim colSettings, objOS, objComputer
> Dim objFix
> Dim objIE, strIETitle, blnFlag, strPrevious, strStatus
> ' Define Msg Box Var
> Message = "Please Enter CR Number"
> Title = "Production Readiness Checklist"
> result = InputBox(Message, Title, "Type CR Number Here", 200, 200)
> fCr = result
>
> Const ForReading = 1
> Set objFSO = CreateObject("Scripting.FileSystemObject")
> Set objTextFile = objFSO.OpenTextFile("c:\scripts\servers.txt",
ForReading)
> Do Until objTextFile.AtEndOfStream
> strComputer = Trim(objTextFile.ReadLine)
> If (strComputer <> "") Then
> Checkit
> End If
> Loop
> ' Save Excel Work*** as CR number.xls
> On Error Resume Next
> objWorkbook.SaveAs("C:\Scripts\" & fCr)
> If Err.Number <> 0 Then
> On Error GoTo 0
> WScript.Echo "Spread*** could not be saved as " & fCr
> WScript.Echo "The path may be invalid."
> strExcelPath = ""
> End If
> On Error GoTo 0
> objExcel.ActiveWorkbook.Close
>
> ' Quit Excel.
> objExcel.Application.Quit
>
> ' Clean up.
> If objFSO.FileExists(strTempFile) Then
> objFSO.DeleteFile(strTempFile)
> End If
> Set objExcel = Nothing
> Set objFSO = Nothing
> objWorkbook.Close
> objExcel.Quit
> objTextFile.Close
> ' =====================================================
> ' Insert your code here
> ' =====================================================
> Sub Checkit
> ' Determin System serial number, manufacturer and Model
> fName = strComputer
> Set objWMIService = GetObject("winmgmts:" &
> "{impersonationLevel=impersonate}!\\" _
> & strComputer & "\root\cimv2")
> If Err.Number <> 0 Then
> On Error GoTo 0
> WScript.Echo strComputer & ": WMI Not Installed"
> Else
> On Error GoTo 0
> End If
> Set SysProduct = objWMIService.ExecQuery("SELECT * FROM
> Win32_ComputerSystemProduct", "WQL", _
> wbemFlagReturnImmediately +
> wbemFlagForwardOnly)
> For Each ProItem In SysProduct
> fsnum = ProItem.IdentifyingNumber
> Next
> Set CompSys = objWMIService.ExecQuery("Select * from
> Win32_ComputerSystem",,48)
>
> For Each sysItem In CompSys
> fman = sysItem.Manufacturer
> fmm = sysItem.Model
> Next
> ' Determin if Rilo Card with Server Name R exist and is Pingable.
> Set objShell = CreateObject("Wscript.Shell")
> Set objFSO = CreateObject("Scripting.FileSystemObject")
> ' Specify temporary file to save ping results.
> strTemp = objShell.ExpandEnvironmentStrings("%TEMP%")
> strTempFile = strTemp & "\RunResult.tmp"
> If IsConnectible(result, 1, 750) Then
> fRiloN = fName & "R"
> fRiloP = "Y"
> Else
> fRiloN = ""
> fRiloP = "N"
> End If
> ' Determin if EHS_LVL2_Intel is a member of the Administrators Group
> Set objGroup = GetObject("WinNT://" & strComputer & "/Administrators")
> For Each objUser In objGroup.Members
> If objUser.Name = "EHS_LVL2_INTEL" Then
> fEhs = "Y"
> Else
> fEhs = "N"
> End If
> Next
> ' OPEN Excel Work*** Template and fill in the blanks
> Set objExcel = CreateObject("Excel.Application")
> objExcel.Visible = True
> objExcel.DisplayAlerts = False
>
> Set objWorkbook =
> objExcel.Workbooks.Open("C:\Scripts\readinesschecklisttemplate.xls")
> Set objWorksheet = objWorkbook.Worksheets(1)
> k = 7
> objWork***.Cells(3, 2).Value = Now
> objWork***.Cells(k, 1).Value = fName
> objWork***.Cells(k, 5).Value = fMan
> objWork***.Cells(k, 6).Value = fMM
> objWork***.Cells(k, 7).Value = fSNum
> objWork***.Cells(k, 8).Value = fRiloN
> objWork***.Cells(k, 9).Value = fRiloP
> objWork***.Cells(k, 13).Value = fEhs
> k = k + 1
> End Sub
> ' =====================================================
> ' End
> ' =====================================================
> Function IsConnectible(strComputer, intPings, intTO)
> ' Returns True if strComputer can be pinged.
> ' Based on a program by Alex Angelopoulos and Torgeir Bakken.
> Dim objFile, strResults
> Set objShell = CreateObject("Wscript.Shell")
> Set objFSO = CreateObject("Scripting.FileSystemObject")
> ' Specify temporary file to save ping results.
> strTemp = objShell.ExpandEnvironmentStrings("%TEMP%")
> strTempFile = strTemp & "\RunResult.tmp"
> If intPings = "" Then intPings = 2
> If intTO = "" Then intTO = 750
>
> Const OpenAsDefault = -2
> Const FailIfNotExist = 0
> Const ForReading = 1
>
> objShell.Run "%comspec% /c ping -n " & intPings & " -w " & intTO _
> & " " & strComputer & "r" & " >" & strTempFile, 0, True
>
> Set objFile = objFSO.OpenTextFile(strTempFile, ForReading, _
> FailIfNotExist, OpenAsDefault)
> strResults = objFile.ReadAll
> objFile.Close
>
> Select Case InStr(strResults, "TTL=")
> Case 0
> IsConnectible = False
> Case Else
> IsConnectible = True
> End Select
> If objFSO.FileExists(strTempfile) Then
> objFSO.DeleteFile(strTempFile)
> End If
> End Function
> '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
>
> "Richard Mueller [MVP]" wrote:
>
> > Hi,
> >
> > One possibility is that strComputer is blank. When I read from a text
file,
> > I generally test for this, as the last line is often a blank. For
example:
> >
> > strComputer = Trim(objTextFile.ReadLine)
> > If (strComputer <> "") Then
> > ....
> > End If
> >
> > I use the Trim function just in case there are any lines with spaces. I
> > believe the error is different if the computer does not have WMI
installed,
> > but that is also possible if they are not all W2k or above. I generally
trap
> > this error with code similar to:
> >
> > On Error Resume Next
> > Set objRemote = GetObject("winmgmts:" _
> > & "{impersonationLevel=impersonate}!\\" _
> > & strComputer & "\root\cimv2")
> > If Err.Number <> 0 Then
> > On Error GoTo 0
> > Wscript.Echo strComputer & ": WMI Not Installed"
> > Else
> > On Error GoTo 0
> > ...
> > End If
> >
> > Note that I also use impersonationLevel. I don't know the consequences
of
> > not.
> >
> > --
> > Richard
> > Microsoft MVP Scripting and ADSI
> > Hilltop Lab web site - http://www.rlmueller.net
> > --
> > "MFelkins" <MFelkins@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
> > news:DB562C9A-E7D7-450D-87A8-A7BB10EA59AB@xxxxxxxxxxxxxxxx
> > > Hi, and thanks for the pointers. Here is my next problem. When I run
the
> > > following script I get an error message;
> > >
> > > PRC1.vbs(32, 1) Microsoft VBScript runtime error: Permission denied:
> > > 'GetObject'
> > > Line 32 is right after ' Determin System serial number, manufacturer
and
> > Model
> > > WScript.Echo strComputer
> > >
> > > If I run the sample script from MS it works just fine. What have I
done
> > wrong?
> > >
> > > Here is the script, so far;
> > >
> > > '=====================================================
> > > 'On Error Resume Next
> > > Dim Message, result
> > > ' Define Msg Box Var
> > > Message = "Please Enter CR Number"
> > > Title = "Production Readiness Checklist"
> > > result = InputBox(Message, Title, "Type CR Number Here", 200, 200)
> > > fCr = result
> > >
> > > Const ForReading = 1
> > > Set objFSO = CreateObject("Scripting.FileSystemObject")
> > > Set objTextFile = objFSO.OpenTextFile("c:\scripts\servers.txt",
> > ForReading)
> > > Do Until objTextFile.AtEndOfStream
> > > strComputer = objTextFile.Readline
> > > fName = strComputer
> > > ' =====================================================
> > > ' Insert your code here
> > > ' =====================================================
> > > ' Determin System serial number, manufacturer and Model
> > > WScript.Echo strComputer
> > > Set objWMIService = GetObject _
> > > ("winmgmts:\\" & strComputer & "\root\cimv2")
> > > Set SysProduct = objWMIService.ExecQuery("SELECT * FROM
> > > Win32_ComputerSystemProduct", "WQL", _
> > > wbemFlagReturnImmediately +
> > > wbemFlagForwardOnly)
> > > For Each ProItem In SysProduct
> > > fsnum = ProItem.IdentifyingNumber
> > > Next
> > > Set CompSys = objWMIService.ExecQuery("Select * from
> > > Win32_ComputerSystem",,48)
> > >
> > > For Each sysItem In CompSys
> > > fman = sysItem.Manufacturer
> > > fmm = sysItem.Model
> > > Next
> > > ' Determin if Rilo Card with Server Name R exist and is Pingable.
> > > Set objShell = CreateObject("Wscript.Shell")
> > > Set objFSO = CreateObject("Scripting.FileSystemObject")
> > > ' Specify temporary file to save ping results.
> > > strTemp = objShell.ExpandEnvironmentStrings("%TEMP%")
> > > strTempFile = strTemp & "\RunResult.tmp"
> > > If IsConnectible(result, 1, 750) Then
> > > fRiloN = fName & "R"
> > > fRiloP = "Y"
> > > Else
> > > fRiloN = ""
> > > fRiloP = "N"
> > > End If
> > > ' Determin if EHS_LVL2_Intel is a member of the Administrators Group
> > > Set objGroup = GetObject("WinNT://" & strComputer & "/Administrators")
> > > For Each objUser In objGroup.Members
> > > If objUser.Name = "EHS_LVL2_INTEL" Then
> > > fEhs = "Y"
> > > Else
> > > fEhs = "N"
> > > End If
> > > Next
> > > ' OPEN Excel Work*** Template and fill in the blanks
> > > Set objWorkbook =
> > > objExcel.Workbooks.Open("C:\Scripts\readinesschecklisttemplate.xls")
> > > Set objWorksheet = objWorkbook.Worksheets(1)
> > > k = 7
> > > objWork***.Cells(3, 2).Value = Now
> > > objWork***.Cells(k, 1).Value = fName
> > > objWork***.Cells(k, 5).Value = fMan
> > > objWork***.Cells(k, 6).Value = fMM
> > > objWork***.Cells(k, 7).Value = fSNum
> > > objWork***.Cells(k, 8).Value = fRiloN
> > > objWork***.Cells(k, 9).Value = fRiloP
> > > objWork***.Cells(k, 13).Value = fEhs
> > > k = k + 1
> > > Loop
> > > ' Save Excel Work*** as CR number.xls
> > > objWorkbook.SaveAs("C:\Scripts\" & fCR)
> > > objWorkbook.Close
> > > objExcel.Quit
> > > objTextFile.Close
> > > ' =====================================================
> > > ' End
> > > ' =====================================================
> > >
> > >
> > >
> > > "Richard Mueller [MVP]" wrote:
> > >
> > > > Mike wrote:
> > > >
> > > > > I have been asked to come up with a method to inventory some
servers
> > and
> > > > add
> > > > > the output to an existing Excel
> > > > > work***. I can create the work*** and add "A" row of data, but
I
> > am
> > > > > unsure as to how I would move to the
> > > > > next row.
> > > > >
> > > > > The next question, of course is;
> > > > >
> > > > > Would it be possible to type in a server name in column 1 row 1
and
> > have
> > > > the
> > > > > script execute and populate
> > > > > the rest of the cells in Row 1 with the information gathered by a
> > > > VBScript?
> > > > > And then move down the list
> > > > > populating as it goes?
> > > >
> > > > Hi,
> > > >
> > > > Here is a sample VBScript program that outputs user Distinguished
Names
> > to
> > > > an Excel spread***:
> > > >
> > > > http://www.rlmueller.net/Create%20User%20List%203.htm
> > > >
> > > > You refer to cells by row and column. In the code linked above:
> > > >
> > > > obj***.Cells(i, j) = "Whatever"
> > > >
> > > > where i is the row and j the column. I increment the rows in a loop
when
> > I
> > > > enumerate users. The first row is a heading.
> > > >
> > > > Also, you might want to use this example program, which uses WMI to
> > > > inventory all computers in a domain. It also writes the output to an
> > Excel
> > > > spread***.
> > > >
> > > > http://www.rlmueller.net/Inventory.htm
> > > >
> > > > For ADO search filter to retrieve all servers, see the code in this
> > program:
> > > >
> > > > http://www.rlmueller.net/Enumerate%20Servers.htm
> > > >
> > > > and to search for all Domain Controllers:
> > > >
> > > > http://www.rlmueller.net/Enumerate%20DCs.htm
> > > >
> > > > --
> > > > Richard
> > > > Microsoft MVP Scripting and ADSI
> > > > Hilltop Lab web site - http://www.rlmueller.net
> > > > --
> > > >
> > > >
> > > >
> >
> >
> >


.

Quantcast