Re: VBScript and Out Put to Excel Work***

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
> > > --
> > >
> > >
> > >
>
>
>
.