?
Solved

Query AD for Event ID 6008

Posted on 2011-05-11
29
Medium Priority
?
387 Views
Last Modified: 2012-06-27
Need script which query AD for the 6008 for the list of server which will stored in notepad, the output should be place in another file in the below format.

---Computername--
6008      <time_date>   <-------------- most recent first
6008        time_date
---Computername--
6008      <time_date>   <-------------- most recent first
6008        time_date

have the script if this could be modifed for the requirement will be appreciated
Script is taken from the question(Thanks to Rob):
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_27018030.html



If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Const EventID = 6008
DateToCheck = DateAdd("d", -30, Now)
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate DateToCheck, True
Dim objRoot:Set objRoot = GetObject("LDAP://RootDSE")
Dim objDomain:Set objDomain = GetObject("LDAP://" & objRoot.Get("defaultNamingContext"))
Set objOUs = GetObject(objDomain.adsPath)
Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objOutput:Set objOutput = objFso.CreateTextFile("6008Events.log")
EnumOUs(objDomain.ADsPath)

objOutput.Close
Set objOutput=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing
wscript.quit 

Sub EnumOUs(adspath)
    Dim objOUs, OU
    Set objOUs = GetObject(adspath)
    objOUs.Filter = Array("OrganizationalUnit")
    Call EnumUsers(objOUs.ADsPath)
    For Each OU In objOUs
        wscript.echo "Processing " & Replace(OU.Name, "OU=", "")
        objOutput.WriteLine Replace(Ucase(OU.Name), "OU=", "")
        Call EnumOUs(OU.ADsPath)
    Next
End Sub

Sub EnumUsers(adspath)
	Dim objServers:Set objServers = GetObject(adspath)
	objServers.Filter = Array("Computer")
	objOutput.WriteLine
	For Each objSvr In objServers
		On Error Resume Next
		If Ping(objSvr.CN) = True Then
			WScript.Echo "Connecting to " & objSvr.CN
			Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & objSvr.CN & "\root\cimv2")
			'wscript.echo "Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'"
			Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'")
			If Err.Number = 0 Then
				For Each objEvent In colEvents
					If Err.Number = 0 Then
					'If x > 3 Then Exit For
						strDate=objEvent.TimeWritten
						strYear=Left(strDate,4)
						strMonth=Mid(strDate,5,2)
						strDay=Mid(strDate,7,2)
						strHour=Mid(strDate,9,2)
						strMin=Mid(strDate,11,2)
						strSec=Mid(strDate,13,2)
						strDate=strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMin & ":" & strSec
						objOutput.WriteLine objSvr.CN & "," & EventID & "," & strDate
					'End If
					Else
						objOutput.WriteLine objSvr.CN & ",Error " & Err.Number & "," & Err.Description
						Err.Clear
					End If
					objOutput.WriteLine
				Next
			Else
				objOutput.WriteLine objSvr.CN & ",WMI Connection Error"
				WScript.Echo "Error connecting to " & objSvr.CN
				Err.Clear
				On Error Goto 0
			End If
		Else
			objOutput.WriteLine objSvr.CN & ",Computer offline"
			WScript.Echo objSvr.CN & " is offline"
		End If
	Next
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
Comment
Question by:rajkiggal
  • 15
  • 14
29 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 35744088
Hi, I haven't tested this, but give it a shot.

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Const EventID = 6008
DateToCheck = DateAdd("d", -30, Now)
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate DateToCheck, True
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adDouble = 5
Dim objRoot:Set objRoot = GetObject("LDAP://RootDSE")
Dim objDomain:Set objDomain = GetObject("LDAP://" & objRoot.Get("defaultNamingContext"))
Set objOUs = GetObject(objDomain.adsPath)
Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objOutput:Set objOutput = objFso.CreateTextFile("6008Events.log")
EnumOUs(objDomain.ADsPath)

objOutput.Close
Set objOutput=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing
wscript.quit 

Sub EnumOUs(adspath)
    Dim objOUs, OU
    Set objOUs = GetObject(adspath)
    objOUs.Filter = Array("OrganizationalUnit")
    Call EnumUsers(objOUs.ADsPath)
    For Each OU In objOUs
        wscript.echo "Processing " & Replace(OU.Name, "OU=", "")
        objOutput.WriteLine Replace(Ucase(OU.Name), "OU=", "")
        Call EnumOUs(OU.ADsPath)
    Next
End Sub

Sub EnumUsers(adspath)
	Dim objServers:Set objServers = GetObject(adspath)
	objServers.Filter = Array("Computer")
	objOutput.WriteLine
	For Each objSvr In objServers
		On Error Resume Next
		If Ping(objSvr.CN) = True Then
			WScript.Echo "Connecting to " & objSvr.CN
			Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & objSvr.CN & "\root\cimv2")
			'wscript.echo "Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'"
			Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'")
			If Err.Number = 0 Then
				Set objDataList = CreateObject("ADOR.Recordset")
				objDataList.Fields.Append "TimeWritten", adVarChar
				objDataList.Fields.Append "FormattedDate", adVarChar
				objDataList.Open
				For Each objEvent In colEvents
					If Err.Number = 0 Then
					'If x > 3 Then Exit For
						strDate=objEvent.TimeWritten
						strYear=Left(strDate,4)
						strMonth=Mid(strDate,5,2)
						strDay=Mid(strDate,7,2)
						strHour=Mid(strDate,9,2)
						strMin=Mid(strDate,11,2)
						strSec=Mid(strDate,13,2)
						strDate=strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMin & ":" & strSec
						objDataList.AddNew
						objDataList("TimeWritten") = objEvent.TimeWritten
						objDataList("FormattedDate") = strDate
						objDataList.Update
					'End If
					Else
						objOutput.WriteLine objSvr.CN & vbTab & "Error " & Err.Number & "," & Err.Description
						Err.Clear
					End If
				Next
				objOutput.WriteLine objSvr.CN
				objDataList.Sort = "TimeWritten"
				While Not objDataList.EOF
					objOutput.WriteLine EventID & vbTab & objDataList("FormattedDate")
					objDataList.MoveNext
				Wend
				objDataList.Close
				objOutput.WriteLine
			Else
				objOutput.WriteLine objSvr.CN & vbTab & "WMI Connection Error"
				WScript.Echo "Error connecting to " & objSvr.CN
				Err.Clear
				On Error Goto 0
			End If
		Else
			objOutput.WriteLine objSvr.CN & vbTab & "Computer offline"
			WScript.Echo objSvr.CN & " is offline"
		End If
	Next
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35744092
Oh, you'll probably need to change
                        objDataList.Sort = "TimeWritten"
to
                        objDataList.Sort = "TimeWritten DESC"

Regards,

Rob.
0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35747921
hi Rob,
could you please change this script to get the server names from notepad stored in one of the server and query in AD , instead of searching for the all the servers in AD.
(as mentioned in the begining of the question).
 Thanks
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 65

Expert Comment

by:RobSampson
ID: 35751353
Hi, sorry, I missed that bit.  I haven't tested it, but it should read from servers.txt

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Const EventID = 6008
strInputFile = "\\server\share\servers.txt"
DateToCheck = DateAdd("d", -30, Now)
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate DateToCheck, True
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adDouble = 5
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Set objInput = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInput.AtEndOfStream
	strServer = objInput.ReadLine
	objOutput.WriteLine
	On Error Resume Next
	If Ping(strServer) = True Then
		WScript.Echo "Connecting to " & strServer
		Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")
		'wscript.echo "Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'"
		Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'")
		If Err.Number = 0 Then
			Set objDataList = CreateObject("ADOR.Recordset")
			objDataList.Fields.Append "TimeWritten", adVarChar
			objDataList.Fields.Append "FormattedDate", adVarChar
			objDataList.Open
			For Each objEvent In colEvents
				If Err.Number = 0 Then
				'If x > 3 Then Exit For
					strDate=objEvent.TimeWritten
					strYear=Left(strDate,4)
					strMonth=Mid(strDate,5,2)
					strDay=Mid(strDate,7,2)
					strHour=Mid(strDate,9,2)
					strMin=Mid(strDate,11,2)
					strSec=Mid(strDate,13,2)
					strDate=strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMin & ":" & strSec
					objDataList.AddNew
					objDataList("TimeWritten") = objEvent.TimeWritten
					objDataList("FormattedDate") = strDate
					objDataList.Update
				'End If
				Else
					objOutput.WriteLine strServer & vbTab & "Error " & Err.Number & "," & Err.Description
					Err.Clear
				End If
			Next
			objOutput.WriteLine strServer
			objDataList.Sort = "TimeWritten DESC"
			While Not objDataList.EOF
				objOutput.WriteLine EventID & vbTab & objDataList("FormattedDate")
				objDataList.MoveNext
			Wend
			objDataList.Close
			objOutput.WriteLine
		Else
			objOutput.WriteLine strServer & vbTab & "WMI Connection Error"
			WScript.Echo "Error connecting to " & strServer
			Err.Clear
			On Error Goto 0
		End If
	Else
		objOutput.WriteLine strServer & vbTab & "Computer offline"
		WScript.Echo strServer & " is offline"
	End If
Wend
objInput.Close
objOutput.Close
Set objOutput=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing
wscript.quit 

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35756525
Hi Rob,

it gave me a error below
Microsoft VBScript runtime error: Object required: 'objFSO'
Exit code :0

thanks
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35759256
That's odd.  Are you runnung it from a VBS file?  What's the line number of the error?
0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35778990
Hi Rob ,

 sorry for teh delay,
Error on line 20, but when i reran the script now it points to line (24, 2) with Object required: 'objOutput'

Thanks
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35781241
Oh, I took out the CreateTextFile line for some reason....

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1

Const EventID = 6008
strInputFile = "\\server\share\servers.txt"
Set objOutput = objFSO.CreateTextFile("6008Events.log", True)
DateToCheck = DateAdd("d", -30, Now)

Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate DateToCheck, True
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adDouble = 5
Set objInput = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInput.AtEndOfStream
	strServer = objInput.ReadLine
	objOutput.WriteLine
	On Error Resume Next
	If Ping(strServer) = True Then
		WScript.Echo "Connecting to " & strServer
		Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")
		'wscript.echo "Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'"
		Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'")
		If Err.Number = 0 Then
			Set objDataList = CreateObject("ADOR.Recordset")
			objDataList.Fields.Append "TimeWritten", adVarChar
			objDataList.Fields.Append "FormattedDate", adVarChar
			objDataList.Open
			For Each objEvent In colEvents
				If Err.Number = 0 Then
				'If x > 3 Then Exit For
					strDate=objEvent.TimeWritten
					strYear=Left(strDate,4)
					strMonth=Mid(strDate,5,2)
					strDay=Mid(strDate,7,2)
					strHour=Mid(strDate,9,2)
					strMin=Mid(strDate,11,2)
					strSec=Mid(strDate,13,2)
					strDate=strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMin & ":" & strSec
					objDataList.AddNew
					objDataList("TimeWritten") = objEvent.TimeWritten
					objDataList("FormattedDate") = strDate
					objDataList.Update
				'End If
				Else
					objOutput.WriteLine strServer & vbTab & "Error " & Err.Number & "," & Err.Description
					Err.Clear
				End If
			Next
			objOutput.WriteLine strServer
			objDataList.Sort = "TimeWritten DESC"
			While Not objDataList.EOF
				objOutput.WriteLine EventID & vbTab & objDataList("FormattedDate")
				objDataList.MoveNext
			Wend
			objDataList.Close
			objOutput.WriteLine
		Else
			objOutput.WriteLine strServer & vbTab & "WMI Connection Error"
			WScript.Echo "Error connecting to " & strServer
			Err.Clear
			On Error Goto 0
		End If
	Else
		objOutput.WriteLine strServer & vbTab & "Computer offline"
		WScript.Echo strServer & " is offline"
	End If
Wend
objInput.Close
objOutput.Close
Set objOutput=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing
wscript.quit 

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35800410
Sorry for the late reply,
Set objInput = objFSO.OpenTextFile(strInputFile, intForReading, False)
this (at line 23,1) gives error Microsoft VBS script runtime error: File not found
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35806340
Hi, did you set the path for the file in this line correctly:
strInputFile = "\\server\share\servers.txt"


Rob.
0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35814520
Hi Rob,
I was able to run file locally(remote path didn't work) on th server, the script was running on only one server and did not make any progress.
all i have is the below error
"Error 3709,The connection cannot be used to perform this operation. It is either closed or invalid in this context."
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35830677
Hi, sorry for my delay....does it say what line number that error is on?  I haven't seen that error with code like this before....

Regards,

Rob.
0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35831932
Hi,
This error was found in the output file, did not get this error while running the script.

While running the script command prompt is showing as
Connecting to "name of the server"

and the output file contains

"name of the server"      Error 3709,The connection cannot be used to perform this operation. It is either closed or invalid in this context.
"name of the server"
any idea!

it won't progress to next server!!
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35837324
Hi, this appears to be an issue with the ADOR.Recordset rather than WMI, so that explains the different error.

See if this works any better....I can't test it at the moment.

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1

Const EventID = 6008
strInputFile = "\\server\share\servers.txt"
Set objOutput = objFSO.CreateTextFile("6008Events.log", True)
DateToCheck = DateAdd("d", -30, Now)

Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate DateToCheck, True
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adDouble = 5
Set objInput = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInput.AtEndOfStream
	strServer = Trim(objInput.ReadLine)
	objOutput.WriteLine
	If strServer <> "" Then
		On Error Resume Next
		If Ping(strServer) = True Then
			WScript.Echo "Connecting to " & strServer
			Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")
			strQuery = "Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'"
			WScript.Echo "Running query: " & strQuery
			Set colEvents = objWMI.ExecQuery(strQuery)
			If Err.Number = 0 Then
				Err.Clear
				Set objDataList = Nothing
				Set objDataList = CreateObject("ADOR.Recordset")
				objDataList.Fields.Append "TimeWritten", adVarChar
				objDataList.Fields.Append "FormattedDate", adVarChar
				objDataList.Open
				For Each objEvent In colEvents
					If Err.Number = 0 Then
					'If x > 3 Then Exit For
						strDate=objEvent.TimeWritten
						strYear=Left(strDate,4)
						strMonth=Mid(strDate,5,2)
						strDay=Mid(strDate,7,2)
						strHour=Mid(strDate,9,2)
						strMin=Mid(strDate,11,2)
						strSec=Mid(strDate,13,2)
						strDate=strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMin & ":" & strSec
						objDataList.AddNew
						objDataList("TimeWritten") = objEvent.TimeWritten
						objDataList("FormattedDate") = strDate
						objDataList.Update
					'End If
					Else
						objOutput.WriteLine strServer & vbTab & "Error " & Err.Number & "," & Err.Description
						Err.Clear
					End If
				Next
				objOutput.WriteLine strServer
				objDataList.Sort = "TimeWritten DESC"
				If Not objDataList.BOF Then objDataList.MoveFirst
				While Not objDataList.EOF
					objOutput.WriteLine EventID & vbTab & objDataList("FormattedDate")
					objDataList.MoveNext
				Wend
				objDataList.Close
				objOutput.WriteLine
			Else
				objOutput.WriteLine strServer & vbTab & "WMI Connection Error"
				WScript.Echo "Error connecting to " & strServer
				Err.Clear
				On Error Goto 0
			End If
		Else
			objOutput.WriteLine strServer & vbTab & "Computer offline"
			WScript.Echo strServer & " is offline"
		End If
	End If
Wend
objInput.Close
objOutput.Close
Set objOutput=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing
wscript.quit 

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35859881
Hi Rob,

have ran the Script, its shows the below line, but no progress

Connecting to "Server_name"
Running query: Select * from Win32_NTLogEvent Where Logfile = 'System' And Event
Code=6008 And TimeWritten > '20110427094249.000000+060'
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35868438
Have you tried changing the topmost server name in the text file?  Just to see if it's a particular problem with that server?

I'll test again tomorrow.

Rob.
0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35871546
have checked with few servers, but all same issue.

Thanks
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 total points
ID: 35872052
Oh, I just tested, and discovered the error.  It was with the creation of the fields in the ADOR.Recordset.  I forgot to add a paremeter.

This should work now.

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1

Const EventID = 6008
strInputFile = "\\server\share\servers.txt"
Set objOutput = objFSO.CreateTextFile("6008Events.log", True)
DateToCheck = DateAdd("d", -30, Now)

Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate DateToCheck, True
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adDouble = 5
Set objInput = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInput.AtEndOfStream
	strServer = Trim(objInput.ReadLine)
	objOutput.WriteLine
	If strServer <> "" Then
		On Error Resume Next
		If Ping(strServer) = True Then
			WScript.Echo "Connecting to " & strServer
			Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")
			strQuery = "Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'"
			WScript.Echo "Running query: " & strQuery
			Set colEvents = objWMI.ExecQuery(strQuery)
				Err.Clear
				On Error GoTo 0
			If Err.Number = 0 Then
				Err.Clear
				Set objDataList = Nothing
				Set objDataList = CreateObject("ADOR.Recordset")
				objDataList.Fields.Append "TimeWritten", adVarChar, MaxCharacters
				objDataList.Fields.Append "FormattedDate", adVarChar, MaxCharacters
				objDataList.Open
				For Each objEvent In colEvents
					If Err.Number = 0 Then
					'If x > 3 Then Exit For
						strDate=objEvent.TimeWritten
						strYear=Left(strDate,4)
						strMonth=Mid(strDate,5,2)
						strDay=Mid(strDate,7,2)
						strHour=Mid(strDate,9,2)
						strMin=Mid(strDate,11,2)
						strSec=Mid(strDate,13,2)
						strDate=strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMin & ":" & strSec
						objDataList.AddNew
						objDataList("TimeWritten") = objEvent.TimeWritten
						objDataList("FormattedDate") = strDate
						objDataList.Update
					'End If
					Else
						objOutput.WriteLine strServer & vbTab & "Error " & Err.Number & "," & Err.Description
						Err.Clear
					End If
				Next
				objOutput.WriteLine strServer
				objDataList.Sort = "TimeWritten DESC"
				If Not objDataList.BOF Then objDataList.MoveFirst
				While Not objDataList.EOF
					objOutput.WriteLine EventID & vbTab & objDataList("FormattedDate")
					objDataList.MoveNext
				Wend
				objDataList.Close
				objOutput.WriteLine
			Else
				objOutput.WriteLine strServer & vbTab & "WMI Connection Error"
				WScript.Echo "Error connecting to " & strServer
				Err.Clear
				On Error Goto 0
			End If
		Else
			objOutput.WriteLine strServer & vbTab & "Computer offline"
			WScript.Echo strServer & " is offline"
		End If
	End If
Wend
objInput.Close
objOutput.Close
Set objOutput=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing
wscript.quit 

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35921051
Sorry for the delay, i will check this today and put comment

thanks
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35956614
Hi, any luck testing this?

Rob.
0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35968953
hi, Sorry did not get time to check, was so busy with work.
will check and let you know by tomorrow.

Thanks
Rajkiggal
0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35976271
Still its not working

I'm getting error: (null): 0x80041001 at line 45,5 in above script.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35979091
OK, that appears to not be returning any events from the event log.  Could you post the text from the message box you get that says
"Running query: Select ...."

Thanks,

Rob.
0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35981784
not exactly, but i'm getting the events from the event log, but the date/time is in the diffrent format

have run the script for 10 servers,  here is the output

Connecting to Server_1
Running query: Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=6008 And TimeWritten > '20110517134056.000000+060'
Connecting to Server_2
Running query: Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=6008 And TimeWritten > '20110517134056.000000+060'
Connecting to Server_3
Running query: Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=6008 And TimeWritten > '20110517134056.000000+060'
Connecting to Server_4
Running query: Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=6008 And TimeWritten > '20110517134056.000000+060'
Connecting to Server_5
Running query: Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=6008 And TimeWritten > '20110517134056.000000+060'
Connecting to Server_6
Running query: Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=6008 And TimeWritten > '20110517134056.000000+060'
C:\6008.vbs(45, 5) (null): 0x80041001
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35985678
So are you getting the events from the first five servers, and just not the sixth?

Is that date format for the TimeWritten property different for that server? I've never heard of that....

Can you run just this code to output one of the TimeWritten values from the System log on that server?  Post the exact TimeWritten string here and I'll match it with the code.

Regards,

Rob.
strServer = "Server_6"
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")
strQuery = "Select * from Win32_NTLogEvent Where Logfile = 'System'"
Set colEvents = objWMI.ExecQuery(strQuery)
For Each objEvent In colEvents
	MsgBox = objEvent.TimeWritten
	Exit For
Next
MsgBox "Done"

Open in new window

0
 
LVL 1

Author Comment

by:rajkiggal
ID: 35999204
Hi Rob,

I will check tomorrow and update you.
0
 
LVL 1

Author Comment

by:rajkiggal
ID: 36012019
Hi Rob,
That's fine problem was with server where the system event log was corrupted and it was unreadable.
Have claered the error on the server and now its working fine.
0
 
LVL 1

Author Closing Comment

by:rajkiggal
ID: 36012044
Excellent Rob,
Thanks for the efforts, this made job easier

Thanks again.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 36014673
Great!  Good to hear.   Thanks for the grade.

Rob.
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month16 days, 14 hours left to enroll

862 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question