Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Script to Check if Machine is Online

Status
Not open for further replies.
djtech2k

djtech2k

MIS
Jul 24, 2003
1,097
US
I am writing a script to do some server management. This script reads from a text file and then connects to each server and performs certain tasks.

One thing I am trying to build in is the ability to check if a server is online before it tries to perform any actions so that the script does not get hung up or fail when running a large list of machines.

My only guess was to do a ping check. I am doing this, but it is not working how I need it to. Here is the check and the function that I am using:

Code: 
If Not IsPingable(objItem) Then
wscript.echo objItem & " is not pingable" & ";" & ";" & ";" & ";" & ";"
wscript.quit
End If

Function IsPingable(objItem)
 Dim objShell, objExec, strCmd, strTemp
 
 strCmd = "ping -n 1 " & objItem
 
 Set objShell = CreateObject("WScript.Shell")
 Set objExec = objShell.Exec(strCmd)
 strTemp = UCase(objExec.StdOut.ReadAll)
 
 If InStr(strTemp, "MS") Then
   IsPingable = True 
 Else
   IsPingable = False
 End If
End Function

Now what is happening is that if the machine is pingable, it carries on and does its thing. However, once it encounters one that is not pingable, then it dies. I know it is because I am doing a quit, but what else can I do that would handle this?

This particular part is inside of a "For Each..Next" Loop that in turn is inside of a "Do While" loop that is reading a text file with server names in it.

Any ideas to do my "online" check or to fix what I am doing now?
 
Sort by date Sort by votes
If Not IsPingable(objItem) Then
wscript.echo objItem & " is not pingable" & ";" & ";" & ";" & ";" & ";"
Else
' do your stuff here
End If


Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
Thanks. I came back to type on this page that I had put that in and I see that you posted exactly what I am trying. I am doing an elseif, but its the same theory. It seems to be working ok. I just want it to skip the bad machine names right away and not wait a long period to do it. This may do the trick.
 
Upvote 0 Downvote
It really depends how the rest of your script is written.

If you're getting the server names. i.e.

Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
....code
Loop

Then simply change it to be

Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
If IsPingable(strComputer) Then
Call some other funtion to test/query/whatever
End If
Loop

--------------------------------------------------------------------------------
dm4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
 
Upvote 0 Downvote
Here is the whole thing:

Code: 
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim objFSO, objTextFile, strNextLine, arrList
Dim objServer, objUser, objItem, strPW, hh
Dim colAccounts, strServers, dts, pwdage, d, mn, ss
Dim objDialog, intResult

wscript.echo "Script Started...." & Now()

If wscript.arguments.count > 0 Then
strServers = wscript.arguments(0)
Else
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Input File|*.txt|All Files|*.*"
objDialog.InitialDir = "C:\"
intResult = objDialog.ShowOpen

If intResult = 0 Then
    Wscript.Quit
End If
strServers = objDialog.filename
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile (strServers, ForReading)

wscript.echo "Server" & ";" & "User" & ";" & "Last Password Set" & ";" & "Password Expired?" & ";" & "Account Locked?" & ";" & "Account Disabled?"

Do Until objTextFile.AtEndOfStream
    strNextLine = objTextFile.Readline
    arrList = Split(strNextLine , vbcrlf)
For Each objItem In arrList

If Not IsPingable(objItem) Then
wscript.echo objItem & " is not pingable" & ";" & ";" & ";" & ";" & ";"
ElseIf IsPingable(objItem) Then

Set objServer = GetObject("WinNT://" & objItem)
Set colAccounts = GetObject("WinNT://" & objServer.name & "")
colAccounts.Filter = Array("user")

For Each objUser In colAccounts
objUser.GetInfo

pwdage=objUser.passwordage    'in unit of second (since password last changed)
dts=pwdage
d=int(dts/60/60/24)
dts=dts mod 60*60*24
hh=right("00" & int(dts/60/60),2)
dts=dts mod 60*60
mn=right("00" & int(dts/60),2)
dts=dts mod 60
ss=right("00" & dts,2)

If d > 88 Then

wscript.echo objServer.Name & ";" & objUser.name & ";" & d & " days " & hh & " hr " & mn & " min " & ss & " seconds ago"_
 & ";" & objUser.passwordexpired & ";" & objUser.isaccountlocked & ";" & objUser.accountdisabled
End If


Next
End If
Next
Loop

wscript.echo "Script Ended...." & Now()

Function IsPingable(objItem)
'     On Error Resume Next
 Dim objShell, objExec, strCmd, strTemp
 
 strCmd = "ping -n 1 " & objItem
 
 Set objShell = CreateObject("WScript.Shell")
 Set objExec = objShell.Exec(strCmd)
 strTemp = UCase(objExec.StdOut.ReadAll)
 
 If InStr(strTemp, "MS") Then
   IsPingable = True 
 Else
   IsPingable = False
 End If
End Function
 
Upvote 0 Downvote
Does your server list text file have server names on each line?? The reason is that you're reading each line and then using Split using VbCrLf as the seperator which shouldn't exist if you're reading one line.

--------------------------------------------------------------------------------
dm4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
 
Upvote 0 Downvote
this is your code with a slight different approach...basically more subs/functions to break things up into manageable chunks

Code: 
Option Explicit

Main()

Sub Main()
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	
	WScript.Echo "Script Started...." & Now()
	
	Dim strServerList : strServerList = GetServerList
	If strServerList = "" Then Exit Sub
	
	Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
	Dim objTextFile : Set objTextFile = objFSO.OpenTextFile (strServerList, ForReading)

	WScript.Echo "Server" & ";" & "User" & ";" & "Last Password Set" & ";" & "Password Expired?" & ";" & "Account Locked?" & ";" & "Account Disabled?"
	
	Dim strComputer
	Do Until objTextFile.AtEndOfStream
	    strComputer = Trim(objTextFile.Readline)
	    If strComputer <> "" Then
		    If Reachable(strComputer) Then			
				GetUserInfo strComputer
			Else
				WScript.Echo strComputer & " is not pingable" & ";" & ";" & ";" & ";" & ";"
			End If
		End If
	Loop
	
	WScript.Echo "Script Ended...." & Now()
End Sub

Sub GetUserInfo(strComputer)
	Dim objComputer : Set objComputer = GetObject("WinNT://" & strComputer)
	objComputer.Filter = Array("user")
	
	Dim objUser, dts, d, hh, mn, ss
	For Each objUser In objComputer
		objUser.GetInfo
		dts = objUser.passwordage
		d = int(dts/60/60/24)
		dts = dts Mod 60*60*24
		hh = right("00" & int(dts/60/60),2)
		dts = dts mod 60*60
		mn = right("00" & int(dts/60),2)
		dts = dts mod 60
		ss = right("00" & dts,2)
		If d > 88 Then
			wscript.echo objComputer.Name & ";" & objUser.name & ";" & d & " days " & hh & " hr " & mn & " min " & ss & " seconds ago"_
			 & ";" & objUser.passwordexpired & ";" & objUser.isaccountlocked & ";" & objUser.accountdisabled
		End If
	Next
End Sub

Function GetServerList
	If WScript.Arguments.Count > 0 Then
		GetServerList = WScript.Arguments(0)
	Else
		Dim objDialog : Set objDialog = CreateObject("UserAccounts.CommonDialog")
		objDialog.Filter = "Text Input File|*.txt|All Files|*.*"
		objDialog.InitialDir = "C:\"
		Dim intResult : intResult = objDialog.ShowOpen

		If intResult <> 0 Then
			GetServerList = objDialog.filename
		End If
	End If
End Function

Function Reachable(strComputer)
	Dim strCmd : strCmd = "ping -n 1 " & strComputer
	Dim objShell : Set objShell = CreateObject("WScript.Shell")
	Dim objExec : Set objExec = objShell.Exec(strCmd)
	Dim strOutput : strOutput = UCase(objExec.StdOut.ReadAll)
	If InStr(strOutput, "REPLY FROM") Then
		Reachable = True
	Else
		Reachable = False
	End If
End Function

--------------------------------------------------------------------------------
dm4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
 
Upvote 0 Downvote
Thanks very much for the "cleanup". As you can probably tell, I am more of a systems engineer that has learned to do some coding, not a programmer.

BTW, on the "pingable" check, I change what it looks for. I have found that it is possible to get something with a "REPLY FROM" from a dead machine. However, you will always have have a response time measured in "MS" if there is a response.

Thanks again.
 
Upvote 0 Downvote
I am really surprised that no one has suggested you use the WMI class designed specifically for this purpose.

Here is a function that will return ping status when provided a machine name or IP address. This gives you more information than just a success or failure and can aid in troubleshooting.

Code: 
On Error Resume Next
[green]'Use IP address or computer name[/green]
strComputer = "127.0.0.1"
strPingStatus = PingStatus(strComputer)
If strPingStatus = "Success" Then
    Wscript.Echo "Success pinging " & strComputer
Else
    Wscript.Echo "Failure pinging " & strComputer & ": " & strPingStatus
End If

'******************************************************************************

Function PingStatus(strComputer)

    On Error Resume Next
    strWorkstation = "."
    Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
    Set colPings = objWMIService.ExecQuery _
      ("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
    For Each objPing in colPings
        Select Case objPing.StatusCode
            Case 0 PingStatus = "Success"
            Case 11001 PingStatus = "Status code 11001 - Buffer Too Small"
            Case 11002 PingStatus = "Status code 11002 - Destination Net Unreachable"
            Case 11003 PingStatus = "Status code 11003 - Destination Host Unreachable"
            Case 11004 PingStatus = _
              "Status code 11004 - Destination Protocol Unreachable"
            Case 11005 PingStatus = "Status code 11005 - Destination Port Unreachable"
            Case 11006 PingStatus = "Status code 11006 - No Resources"
            Case 11007 PingStatus = "Status code 11007 - Bad Option"
            Case 11008 PingStatus = "Status code 11008 - Hardware Error"
            Case 11009 PingStatus = "Status code 11009 - Packet Too Big"
            Case 11010 PingStatus = "Status code 11010 - Request Timed Out"
            Case 11011 PingStatus = "Status code 11011 - Bad Request"
            Case 11012 PingStatus = "Status code 11012 - Bad Route"
            Case 11013 PingStatus = "Status code 11013 - TimeToLive Expired Transit"
            Case 11014 PingStatus = _
              "Status code 11014 - TimeToLive Expired Reassembly"
            Case 11015 PingStatus = "Status code 11015 - Parameter Problem"
            Case 11016 PingStatus = "Status code 11016 - Source Quench"
            Case 11017 PingStatus = "Status code 11017 - Option Too Big"
            Case 11018 PingStatus = "Status code 11018 - Bad Destination"
            Case 11032 PingStatus = "Status code 11032 - Negotiating IPSEC"
            Case 11050 PingStatus = "Status code 11050 - General Failure"
            Case Else PingStatus = "Status code " & objPing.StatusCode & _
               " - Unable to determine cause of failure."
        End Select
    Next

End Function

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at
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.
 
Upvote 0 Downvote
I thought about that first Mark, but I elected to go away from WMI calls because I was afraid that when trying to connect via WMI to the target machine, it would take longer to timeout than just a test ping.
 
Upvote 0 Downvote
Actually, I was going to throw in a WMI ping function instead since it does not rely on WMI of the remote machine...it uses the local machine to ping the remote just like a regular ping and it is slightly quicker from my experience.

The only reason I did not include it is that it will only work if it is run on a machine with WinXP or greater. i.e. WinXP, Win2k3, Vista, etc

--------------------------------------------------------------------------------
dm4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
 
Upvote 0 Downvote
Nice script
Mark or dm4ever how can I get the Ping case to write to file using f.WriteLine

Code: 
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
	Const Data_Path = "C:\Backup\"
	Const fileName = "Users.csv"
    Dim strServerList : strServerList = "c:\server.txt"
    If strServerList = "" Then GetServerList
    
    Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objTextFile : Set objTextFile = objFSO.OpenTextFile (strServerList, ForReading)
	Dim f
	If Not objFSO.FileExists(Data_Path & filename) Then
	  Set f = objFSO.OpenTextFile(Data_Path & fileName,2, True)
	Else
	  Set f = objFSO.OpenTextFile(Data_Path & fileName,8)
	End If 
		
    f.WriteLine  "Script Started...." & Now()
    
    f.WriteLine "Server" & "," & "User" & "," & "Last Password Set" & "," & "Password Expired?" & "," & "Account Locked?" & "," & "Account Disabled?"
    
    Dim strComputer
    Do Until objTextFile.AtEndOfStream
        strComputer = Trim(objTextFile.Readline)
        If strComputer <> "" Then
            If Reachable(strComputer) Then            
                GetUserInfo strComputer
            Else
		PingStatus strComputer
            End If
        End If
    Loop
    
    f.WriteLine "Script Ended...." & Now()
	wscript.echo "Done"


Sub GetUserInfo(strComputer)
		Dim objComputer : Set objComputer = GetObject("WinNT://" & strComputer)		

    objComputer.Filter = Array("user")
    
    Dim objUser, dts, d, hh, mn, ss
    For Each objUser In objComputer
        objUser.GetInfo
        dts = objUser.passwordage
        d = int(dts/60/60/24)
        dts = dts Mod 60*60*24
        hh = right("00" & int(dts/60/60),2)
        dts = dts mod 60*60
        mn = right("00" & int(dts/60),2)
        dts = dts mod 60
        ss = right("00" & dts,2)
        If d > 88 Then
            f.WriteLine VbCrLf & objComputer.Name & "," & objUser.name & "," & d & " days " & hh & " hr " & mn & " min " & ss & " seconds ago"_
             & "," & objUser.passwordexpired & "," & objUser.isaccountlocked & "," & objUser.accountdisabled
        End If
    Next
End Sub

Function GetServerList
    If WScript.Arguments.Count > 0 Then
        GetServerList = WScript.Arguments(0)
    Else
        Dim objDialog : Set objDialog = CreateObject("UserAccounts.CommonDialog")
        objDialog.Filter = "Text Input File|*.txt|All Files|*.*"
        objDialog.InitialDir = "C:\"
        Dim intResult : intResult = objDialog.ShowOpen

        If intResult <> 0 Then
            GetServerList = objDialog.filename
        End If
    End If
End Function

Function Reachable(strComputer)
    Dim strCmd : strCmd = "ping -n 1 " & strComputer
    Dim objShell : Set objShell = CreateObject("WScript.Shell")
    Dim objExec : Set objExec = objShell.Exec(strCmd)
    Dim strOutput : strOutput = UCase(objExec.StdOut.ReadAll)
    If InStr(strOutput, "REPLY FROM") Then
        Reachable = True
    Else
        Reachable = False 
    End If
End Function

Function PingStatus(strComputer)

    On Error Resume Next
    strWorkstation = "."
    Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
    Set colPings = objWMIService.ExecQuery _
      ("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
    For Each objPing in colPings
        Select Case objPing.StatusCode
            Case 0 PingStatus = "Success"
            Case 11001 PingStatus = "Status code 11001 - Buffer Too Small"
            Case 11002 PingStatus = "Status code 11002 - Destination Net Unreachable"
            Case 11003 PingStatus = "Status code 11003 - Destination Host Unreachable"
            Case 11004 PingStatus = _
              "Status code 11004 - Destination Protocol Unreachable"
            Case 11005 PingStatus = "Status code 11005 - Destination Port Unreachable"
            Case 11006 PingStatus = "Status code 11006 - No Resources"
            Case 11007 PingStatus = "Status code 11007 - Bad Option"
            Case 11008 PingStatus = "Status code 11008 - Hardware Error"
            Case 11009 PingStatus = "Status code 11009 - Packet Too Big"
            Case 11010 PingStatus = "Status code 11010 - Request Timed Out"
            Case 11011 PingStatus = "Status code 11011 - Bad Request"
            Case 11012 PingStatus = "Status code 11012 - Bad Route"
            Case 11013 PingStatus = "Status code 11013 - TimeToLive Expired Transit"
            Case 11014 PingStatus = _
              "Status code 11014 - TimeToLive Expired Reassembly"
            Case 11015 PingStatus = "Status code 11015 - Parameter Problem"
            Case 11016 PingStatus = "Status code 11016 - Source Quench"
            Case 11017 PingStatus = "Status code 11017 - Option Too Big"
            Case 11018 PingStatus = "Status code 11018 - Bad Destination"
            Case 11032 PingStatus = "Status code 11032 - Negotiating IPSEC"
            Case 11050 PingStatus = "Status code 11050 - General Failure"
            Case Else PingStatus = "Status code " & objPing.StatusCode & _
               " - Unable to determine cause of failure."
        End Select
    Next
End Function
 
Upvote 0 Downvote
Code: 
              pstat = PingStatus(strComputer)
              f.WriteLine pstat
            End If
        End If
    Loop
    
    f.WriteLine "Script Ended...."

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at
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.
 
Upvote 0 Downvote
Ok, now I need to make a change. I need to add an option to put out my output as a delimited file as I have above OR in a spreadsheet. I am working on it and trying to make it broken down into functions as dm4ever did. I am having a little bit of trouble breaking it all out but I am giving it a shot.
 
Upvote 0 Downvote
Ok, I keep hitting an error trying to open the spreadsheet. Here is my code. I am sure that i am missing something dumb, but my eyes are crossed from looking at this so much.

Code: 
Option Explicit

Main()

Sub Main()
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    
    WScript.Echo "Script Started...." & Now()
    
    Dim strServerList : strServerList = GetServerList
    If strServerList = "" Then Exit Sub
    
    Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objTextFile : Set objTextFile = objFSO.OpenTextFile (strServerList, ForReading)
	Dim strArgument1 : strArgument1 = wscript.arguments(1)
	Dim strArgument2 : strArgument2 = wscript.arguments(2)
	Dim intRow : intRow = "1"

		If strArgument1 = "X" Then
		Call SetupExcel(strArgument2)

		objSheet.Cells(intRow, 1).Value = "Server"
		objSheet.Cells(intRow, 2).Value = "User"
		objSheet.Cells(intRow, 3).Value = "Last PW Set in Days"
		objSheet.Cells(intRow, 4).Value = "PW Expired?"
		objSheet.Cells(intRow, 5).Value = "Locked?"
		objSheet.Cells(intRow, 6).Value = "Disabled?"
		intRow = intRow + 1
		ElseIf strArgument1 = "T" Then

    WScript.Echo "Server" & ";" & "User" & ";" & "Last Password Set in Days" & ";" & "Password Expired?" & ";" & "Account Locked?" & ";" & "Account Disabled?"
    
		End If

    Dim strComputer
    Do Until objTextFile.AtEndOfStream
        strComputer = Trim(objTextFile.Readline)
        If strComputer <> "" Then
            If Reachable(strComputer) Then            
                Call GetUserInfo(strComputer,intRow)
            Else
				If strArgument1 = "T" Then
                WScript.Echo strComputer & " is not pingable" & ";" & ";" & ";" & ";" & ";"
				ElseIf strArgument1 = "T" Then
				objSheet.Cells(intRow, 1).Value = strComputer
				intRow = intRow + 1
				End If
            End If
        End If
    Loop
    
    WScript.Echo "Script Ended...." & Now()
End Sub

Sub GetUserInfo(strComputer,intRow)
    Dim objComputer : Set objComputer = GetObject("WinNT://" & strComputer)
    objComputer.Filter = Array("user")
    
    Dim objUser, dts, d, hh, mn, ss
    For Each objUser In objComputer
        objUser.GetInfo
        dts = objUser.passwordage
        d = int(dts/60/60/24)
        dts = dts Mod 60*60*24
        hh = right("00" & int(dts/60/60),2)
        dts = dts mod 60*60
        mn = right("00" & int(dts/60),2)
        dts = dts mod 60
        ss = right("00" & dts,2)
        If d > 88 Then
			If strArgument1 = "T" Then
            wscript.echo objComputer.Name & ";" & objUser.name & ";" & d & ";" & objUser.passwordexpired & ";" & _
			objUser.isaccountlocked & ";" & objUser.accountdisabled
			ElseIf strArgument1 = "X" Then
			objSheet.Cells(intRow, 1).Value = objComputer.Name
			objSheet.Cells(intRow, 2).Value = objUser.name
			objSheet.Cells(intRow, 3).Value = d
			objSheet.Cells(intRow, 4).Value = objUser.passwordexpired
			objSheet.Cells(intRow, 5).Value = objUser.isaccountlocked
			objSheet.Cells(intRow, 6).Value = objComputer.accountdisabled
			End If
				intRow = intRow + 1
        End If
    Next
End Sub

Function GetServerList
    If WScript.Arguments.Count > 0 Then
        GetServerList = WScript.Arguments(0)
    Else
        Dim objDialog : Set objDialog = CreateObject("UserAccounts.CommonDialog")
        objDialog.Filter = "Text Input File|*.txt|All Files|*.*"
        objDialog.InitialDir = "C:\"
        Dim intResult : intResult = objDialog.ShowOpen

        If intResult <> 0 Then
            GetServerList = objDialog.filename
        End If
    End If
End Function

Function Reachable(strComputer)
    Dim strCmd : strCmd = "ping -n 1 " & strComputer
    Dim objShell : Set objShell = CreateObject("WScript.Shell")
    Dim objExec : Set objExec = objShell.Exec(strCmd)
    Dim strOutput : strOutput = UCase(objExec.StdOut.ReadAll)
    If InStr(strOutput, "MS") Then
        Reachable = True
    Else
        Reachable = False
    End If
End Function

Function SetupExcel(strArgument2)
	Dim strExcelPath : strExcelPath = strArgument2
wscript.echo strExcelPath

	' Check for required arguments.
	If Not strArgument2 <> "" Then
	  Wscript.Echo "Argument <SpreadsheetName> required. For example:" _
		& vbCrLf _
		& "cscript script.vbs c:\servers.txt X c:\output.xls"
	  Wscript.Quit(0)
	End If

	' Bind to Excel object.
	On Error Resume Next
	Dim objExcel : Set objExcel = CreateObject("Excel.Application")
	If Err.Number <> 0 Then
	  On Error GoTo 0
	  Wscript.Echo "Excel application not found."
	  Wscript.Quit
	End If
	On Error GoTo 0

	' Open spreadsheet.
	On Error Resume Next
	objExcel.Workbooks.Open strExcelPath
	objExcel.Visible = True
	If Err.Number <> 0 Then
	  On Error GoTo 0
	  Wscript.Echo "Spreadsheet cannot be opened: " & strExcelPath
	  Wscript.Quit
	End If
	On Error GoTo 0

End Function
 
Upvote 0 Downvote
You know breaking things into subs/functions helps break things up into manageable blocks, but at the same time it adds a bit more work...especially for those used to using Global Variables...which is why I think so many avoid it. I'll take a look and post back if someone hasn't done so.

--------------------------------------------------------------------------------
dm4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
 
Upvote 0 Downvote
This should get you going...I'll try to cleanup and add more comments if time allows.

I'm not a programmer either and know this can be a bit much to take in at first...function/subs require a bit more work if you don't use global variables because you need to pass values/objects around rather than relying on those global variables...worth it in my opinion though.

Code: 
Option Explicit

Main()

Sub Main()
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    
    WScript.Echo "Script Started...." & Now()
    
    ' call function to get server/computer list file location
    Dim strServerList : strServerList = GetServerList
    ' if no input file is specified then exit the sub/quit the script
    If strServerList = "" Then Exit Sub
    
    Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objTextFile : Set objTextFile = objFSO.OpenTextFile(strServerList, ForReading)
    ' get output format by calling sub; will ask for parameters if not passed via command line
    Dim strOutputFormat : strOutputFormat = GetOuputFileFormat
    ' exit if no output format specified
    If strOutputFormat = "" Then Exit Sub
    Dim strOutputFile : strOutputFile = GetOutputFilePath(strOutputFormat)
    Dim intRow : intRow = "1"
	
	Select Case strOutputFormat
		Case "EXCEL"
			' if excel format is chosen then get object by calling setupexcel function
			Dim objExcel : Set objExcel = SetupExcel(strOutputFile)
	        objExcel.Cells(intRow, 1).Value = "Server"
	        objExcel.Cells(intRow, 2).Value = "User"
	        objExcel.Cells(intRow, 3).Value = "Last PW Set in Days"
	        objExcel.Cells(intRow, 4).Value = "PW Expired?"
	        objExcel.Cells(intRow, 5).Value = "Locked?"
	        objExcel.Cells(intRow, 6).Value = "Disabled?"
	        intRow = intRow + 1
		Case "TEXT"
			WScript.Echo "Server" & ";" & "User" & ";" & _
						 "Last Password Set in Days" & ";" & _
						 "Password Expired?" & ";" & "Account Locked?" & _
						 ";" & "Account Disabled?"
		Case Else
	End Select

    Dim strComputer
    Do Until objTextFile.AtEndOfStream
        strComputer = Trim(objTextFile.Readline)
        If strComputer <> "" Then
            If Reachable(strComputer) Then 
                Call GetUserInfo(strComputer, strOutputFormat, objExcel, intRow)
            Else
                Select Case strOutputFormat
					Case "EXCEL"	objExcel.Cells(intRow, 1).Value = strComputer
					Case "TEXT"		WScript.Echo strComputer & " is not pingable" & ";" & ";" & ";" & ";" & ";"
               	End Select
            End If
            intRow = intRow + 1
        End If
    Loop
    
    WScript.Echo "Script Ended...." & Now()
End Sub

Sub GetUserInfo(strComputer, strOutputFormat, objOutFile, intRow)
	Dim objComputer : Set objComputer = GetObject("WinNT://" & strComputer)
	objComputer.Filter = Array("user")

	Dim objUser, dts, d, hh, mn, ss
	For Each objUser In objComputer
		objUser.GetInfo
		dts = objUser.passwordage
		d = int(dts/60/60/24)
		dts = dts Mod 60*60*24
		hh = right("00" & int(dts/60/60),2)
		dts = dts mod 60*60
		mn = right("00" & int(dts/60),2)
		dts = dts mod 60
		ss = right("00" & dts,2)
		If d > 88 Then
			Select Case strOutputFormat
				Case "EXCEL"
					objOutFile.Cells(intRow, 1).Value = objComputer.Name
					objOutFile.Cells(intRow, 2).Value = objUser.name
					objOutFile.Cells(intRow, 3).Value = d
					objOutFile.Cells(intRow, 4).Value = objUser.passwordexpired
					objOutFile.Cells(intRow, 5).Value = objUser.isaccountlocked
					objOutFile.Cells(intRow, 6).Value = objUser.accountdisabled
				Case "TEXT"
					WScript.Echo objComputer.Name & ";" & objUser.name & ";" & d & ";" & objUser.passwordexpired & ";" & _
					objUser.isaccountlocked & ";" & objUser.accountdisabled
			End Select
			intRow = intRow + 1
		End If
	Next
End Sub

Function GetServerList
	If WScript.Arguments.Count > 0 Then
		GetServerList = WScript.Arguments(0)
	Else
		Dim objDialog : Set objDialog = CreateObject("UserAccounts.CommonDialog")
		objDialog.Filter = "Text Input File|*.txt|All Files|*.*"
		objDialog.InitialDir = "C:\"
		Dim intResult : intResult = objDialog.ShowOpen
		
		If intResult <> 0 Then
			GetServerList = objDialog.filename
		End If
	End If
End Function

Function GetOuputFileFormat
	Dim strOutputFormat : strOutputFormat = UCase(WScript.Arguments.Named("format"))
	If strOutputFormat = "" Then strOutputFormat = UCase(InputBox(_
	"Enter output file format. i.e. X or Excel for Excel. T or Text for Text", "Output File Format", "Text"))
	Select Case strOutputFormat
		Case "X", "EXCEL" 	GetOuputFileFormat = "EXCEL"
		Case "T", "TEXT" 	GetOuputFileFormat = "TEXT"
		Case Else 			GetOuputFileFormat = ""
	End Select
End Function

Function GetOutputFilePath(strOutputFormat)
	Dim strOutputFile : strOutputFile = UCase(WScript.Arguments.Named("outfile"))
	Dim strDefaultPath
	Select Case strOutputFormat
		Case "EXCEL"	strDefaultPath = "C:\temp\output.xls"
		Case "TEXT" 	strDefaultPath = ""
	End Select
	If strOutputFile = "" Then strOutputFile = UCase(InputBox("Enter the output file path.", "Output File Path", strDefaultPath))
	GetOutputFilePath = strOutputFile
End Function

Function Reachable(strComputer)
	Dim strCmd : strCmd = "ping -n 1 " & strComputer
	Dim objShell : Set objShell = CreateObject("WScript.Shell")
	Dim objExec : Set objExec = objShell.Exec(strCmd)
	Dim strOutput : strOutput = UCase(objExec.StdOut.ReadAll)
	If InStr(strOutput, "MS") Then
		Reachable = True
	Else
		Reachable = False
	End If
End Function

Function SetupExcel(strExcelPath)
	WScript.Echo strExcelPath
	
	' Check for required arguments.
	If Not strExcelPath <> "" Then
		WScript.Echo "Argument <SpreadsheetName> required. For example:" _
					 & VbCrLf _
					 & "cscript script.vbs c:\servers.txt /format:x /outfile:c:\output.xls"
		Wscript.Quit(0)
	End If
	
	' Bind to Excel object.
	On Error Resume Next
	Dim objExcel : Set objExcel = CreateObject("Excel.Application")
	If Err.Number <> 0 Then
		WScript.Echo "Excel application not found."
		Wscript.Quit
	End If
	On Error GoTo 0
	
	' Open spreadsheet.
	On Error Resume Next
	objExcel.Workbooks.Open strExcelPath
	objExcel.Visible = True
	If Err.Number <> 0 Then
		On Error GoTo 0
		WScript.Echo "Spreadsheet cannot be opened: " & strExcelPath
		Wscript.Quit
	End If
	On Error GoTo 0
	
	Set SetupExcel = objExcel
End Function

--------------------------------------------------------------------------------
dm4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
 
Upvote 0 Downvote
it seems that all you are doing is opening the existing file, so why not just use Wscript.Run strExcelPath?

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at
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.
 
Upvote 0 Downvote
It is actually opening an Excel file and writing to it...WScript.Run would not open it and allow for this.

This script is definitely not complete just yet...it all depends on what the expected outcome is.

--------------------------------------------------------------------------------
dm4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

bdwilcox
  • Locked
  • Question
Trying to adapt VBScript to search if machine is in an AD group 6
Replies
8
Views
1K
SoftwareRT
SoftwareRT
bdwilcox
  • Locked
  • Question
Script seeing input variable value as blank but sees hard-coded value 4
Replies
6
Views
796
bdwilcox
bdwilcox
PiotrMP006
  • Locked
  • Question
How to quickly check if a file has 1 or more lines of text?
Replies
1
Views
354
combo
combo
S
  • Locked
  • Question
Need to submit page when clicking a checkbox
Replies
0
Views
315
shbr5413
S
Alexvb6
  • Locked
  • Question
Deprecation of VBScript + Classic ASP: How to Ask Microsoft to cancel their planned craziness
Replies
0
Views
519
Alexvb6
Alexvb6

Part and Inventory Search

Sponsor

Back
Top