asked on

Query AD for Event ID 6008 for Sub OU with duration of 30 Days

Query AD for Event ID 6008 inclusding Sub OU with duration of 30 Days
have the script obtained from below links
https://www.experts-exchange.com/questions/22390782/Query-AD-for-Event-ID-6008.html
and
https://www.experts-exchange.com/questions/22391693/Event-ID-6008-and-CDO.html

when i run the script it gives error "(null): 0x80041021" on the below line
"Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Servers & "\root\cimv2")"
And i also need the events for last 30 days!
please help!

Const EventID = 6008
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("C:\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
       Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Servers & "\root\cimv2")
       Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID)
       For Each objEvent In colEvents
          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 strPC & "," & EventID & "," & strDate
	    objOutput.WriteLine
Next
End sub

Open in new window

RobSampson

Hi there, give this a try.

Regards,

Rob.

Const EventID = 6008
DateToCheck = DateAdd("d", -30, Now)
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("C:\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
		Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & objServers.CN & "\root\cimv2")
		Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > " & DateToCheck)
		If Err.Number = 0 Then
			On Error Goto 0
			For Each objEvent In colEvents
				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 strPC & "," & EventID & "," & strDate
					objOutput.WriteLine
				End If
			Next
		Else
			MsgBox "Error connecting to " & objServers.CN
			Err.Clear
			On Error Goto 0
		End If
	Next
End Sub

Open in new window

rajkiggal

ASKER

Did not work ended up in below Error
"Microsoft VBScript runtime error: Object required: 'dtmStartDate' "

RobSampson

Oops, sorry. I forgot to define dtmStartDate

Try this.

Regards,

Rob.

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("C:\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
		Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & objServers.CN & "\root\cimv2")
		Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > " & DateToCheck)
		If Err.Number = 0 Then
			On Error Goto 0
			For Each objEvent In colEvents
				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 strPC & "," & EventID & "," & strDate
					objOutput.WriteLine
				End If
			Next
		Else
			MsgBox "Error connecting to " & objServers.CN
			Err.Clear
			On Error Goto 0
		End If
	Next
End Sub

Open in new window

rajkiggal

ASKER

Hi ,
Its still not working, when run the script it give error in small popup window which says "Error connecting to" , have attached the screenshot.

i guess this script is unable to scan the sub OUs!!

error.JPG

RobSampson

Oh whoops! Another typo.....I can't test this at the moment...I think this is right.

Regards,

Rob.

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("C:\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
		Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & objSvr.CN & "\root\cimv2")
		Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > " & DateToCheck)
		If Err.Number = 0 Then
			On Error Goto 0
			For Each objEvent In colEvents
				'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
					objOutput.WriteLine
				'End If
			Next
		Else
			MsgBox "Error connecting to " & objSvr.CN
			Err.Clear
			On Error Goto 0
		End If
	Next
End Sub

Open in new window

rajkiggal

ASKER

script excuted without error,
but output file have only ou names, no comupter name or event details.
any idea,

RobSampson

Not sure yet, I'm not at work to test, but above this:
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & objSvr.CN & "\root\cimv2")

put this
wscript.echo "Connecting to " & objSvr.CN

Then run the script from a DOS prompt using
cscript C:\Scripts\GetEvents.vbs

and see whether you see the above message.

Regards,

Rob.

rajkiggal

ASKER

Hi Rob,
have inserted the line as you said

but its giving error: 0x80041017, code:80041017 and source: (null) for line 42 char 4

RobSampson

Hmmm, odd....it works for me....try this version.

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
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("C:\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
		WScript.Echo "Connecting to " & objSvr.CN
		Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & objSvr.CN & "\root\cimv2")
		Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > " & DateToCheck)
		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
			MsgBox "Error connecting to " & objSvr.CN
			Err.Clear
			On Error Goto 0
		End If
	Next
End Sub

Open in new window

rajkiggal

ASKER

Script worked, output is showing as
Server_name Error -2147217385
instead of
server_name 6008 date_time

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

rajkiggal

ASKER

Thanks for the script it worked,
few things needs to be added to the script, have posted a new question for that!, hope you will help

https://www.experts-exchange.com/questions/27031709/Query-AD-for-Event-ID-6008.html