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
If strOutputFormat = "EXCEL" Then ExcelCleanUp objExcel, strOutputFile
WScript.Echo "Script Ended...." & Now()
End Sub
Sub ExcelCleanUp(objExcel, strOutputFile)
objExcel.ActiveWorkbook.SaveAs strOutputFile
objExcel.Quit
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.Add
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