• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 414
  • Last Modified:

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
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_22390782.html
and
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_22391693.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

0
rajkiggal
Asked:
rajkiggal
  • 6
  • 6
1 Solution
 
RobSampsonCommented:
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

0
 
rajkiggalAuthor Commented:
Did not work ended up in below Error
"Microsoft VBScript runtime error: Object required: 'dtmStartDate' "
0
 
RobSampsonCommented:
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

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
rajkiggalAuthor Commented:
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
0
 
RobSampsonCommented:
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

0
 
rajkiggalAuthor Commented:
script excuted without error,
but output file have only ou names, no comupter name or event details.
any idea,
0
 
RobSampsonCommented:
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.
0
 
rajkiggalAuthor Commented:
Hi Rob,
have inserted the line as you said

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


0
 
RobSampsonCommented:
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

0
 
rajkiggalAuthor Commented:
Script worked, output is showing as
Server_name Error -2147217385
 instead of
server_name 6008 date_time
0
 
RobSampsonCommented:
OK, I've tested a bit further, and added some improvements.  Try this.

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("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
 
rajkiggalAuthor Commented:
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

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_27031709.html
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 6
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now