Would really appreciate some help with this code, basically want it to compile a list of servers and then check they are online (cannot just ping them as the servers are virtual machines and have an issue where they freeze but still respond to ping) then write this to another file and then delete the original server text file.
At the moment the script works, but if the server is powered off this will return error "Network Path Not Found" when running the script.
Thanks in advance.
At the moment the script works, but if the server is powered off this will return error "Network Path Not Found" when running the script.
Thanks in advance.
Code:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("C:\Acceptance Check Scripts\ServerList.txt", True)
Dim objRootDSE, strDNSDomain, adoConnection, adoCommand, strQuery
Dim adoRecordset, strComputerDN, strBase, strFilter, strAttributes
' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use ADO to search Active Directory for all computers.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on computer objects with server operating system.
strFilter = "(&(objectCategory=computer)(operatingSystem=*server*))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "Name"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
' Enumerate computer objects with server operating systems.
Do Until adoRecordset.EOF
strComputerDN = adoRecordset.Fields("Name").Value
objFile.WriteLine strComputerDN
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
adoConnection.Close
objFile.Close
strComputer = ""
strComputerDN = ""
Dim filesys
Dim strPingResults
Const ForReading = 1
Const ForWritting = 2
Set objFileOnline = objFSO.CreateTextFile("C:\Acceptance Check Scripts\OnlineServers.txt", True)
Set objServerList = CreateObject("Scripting.FileSystemObject")
objServerList = objFSO.OpenTextFile _
("C:\Acceptance Check Scripts\ServerList.txt", ForReading).ReadAll
arrServers = Split(objServerList, vbCrLf)
'On Error Goto 78
For Each strComputer In arrServers
'Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'Set colListOfServices = objWMIService.ExecQuery("Select * from Win32_Service Where Name ='RpcSs'")
Set objComputer = GetObject("WinNT://" & strComputer & ",computer")
Set objService = objComputer.GetObject("service", "RpcSs")
Set filesys = CreateObject("Scripting.FileSystemObject")
'If objService.State = 4 Then
If objService.Status = 4 Then
objFileOnline.WriteLine strComputer
Else
MsgBox "Suspected Server Freeze, Server " & strComputer & ", " & objService.Status & ", Removed From Scripts"
End If
Next
' Clean up.
'objFileOnline.Close
'objServerList.Close
'filesys.DeleteFile "C:\Acceptance Check Scripts\ServerList.txt"
Wscript.Echo "Done"