Adding Files and VBscript

Hello,

   I have a VBscript below that works well, it writes a .txt report file out to my server.  The only problem is that it over-writes on top of the existing .txt file.  How can I re-code this to write separate files each time the report is generated to that location.  These txt files are nothing more than to preserve the report just in case we need them for an audit or a later date.

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
strLogFolder = "\\test-server\logs\AuthFail\Logs\"
'strLogFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
 
' Set this to the maximum lockouts at which to trigger, inclusive
Const AuthFailThreshold = 100
 
' Email variables:
strServer = "mailhost.abc.com"
strTo = "john.doe@abc.com
strFrom = "john.doe@abc.com"
strSubject = "Threshold Report"
strBody = "Flagged accounts that have exceeded the 100 Authorization Fail threshold count in one day." & VbCrLf
 
Const ForReading = 1
Const adVarChar = 200
Const MaxCharacters = 255
Const adDouble = 5
 
boolThresholdReached = False
 
strShortDate = objShell.RegRead("HKCU\Control Panel\International\sShortDate")
If InStr(LCase(strShortDate), "d") < InStr(LCase(strShortDate), "m") Then
	strDateFormat = "dd/mm/yyyy"
Else
	strDateFormat = "mm/dd/yyyy"
End If
 
strDate = InputBox("Please enter the date of the files that you want to search" & VbCrLf & _
	"in " & strDateFormat & " format:", "Date to Search", strDateFormat)
 
If strDate <> "" And strDate <> strDateFormat Then
	
	dteDateFrom = CDate(strDate & " 00:00:00 AM")
	dteDateTo = CDate(strDate & " 11:59:59 PM")
	
	WScript.Echo "Parsing log folder " & strLogFolder & " for files created on " & strDate & VbCrLf & VbCrLf
	strReport = "Parsing log folder " & strLogFolder & " for files created on " & strDate & VbCrLf & VbCrLf
	
	' Create the recordset to hold the entire data from each file parsed
	Set objData = CreateObject("ADOR.Recordset")
	objData.Fields.Append "Username", adVarChar, MaxCharacters
	objData.Fields.Append "DateTime", adVarChar, MaxCharacters
	objData.Fields.Append "DC", adVarChar, MaxCharacters
	objData.Fields.Append "IPAddress", adVarChar, MaxCharacters
	objData.Open
	
	' Create the recordset to hold the information for each user once all of the files have been parsed
	Set objUsers = CreateObject("ADOR.Recordset")
	objUsers.Fields.Append "Username", adVarChar, MaxCharacters
	objUsers.Fields.Append "DistinguishedName", adVarChar, MaxCharacters
	objUsers.Fields.Append "IPAddress", adVarChar, MaxCharacters
	objUsers.Fields.Append "AuthFailCount", adDouble
	objUsers.Open
 
	For Each objFile In objFSO.GetFolder(strLogFolder).Files
		If CDate(objFile.DateLastModified) > dteDateFrom And CDate(objFile.DateLastModified) < dteDateTo And Right(LCase(objFile.Name), 4) <> ".vbs" Then
			WScript.Echo "Parsing file " & objFile.Name & VbCrLf & VbCrLf
			strReport = strReport & "Parsing file " & objFile.Name & VbCrLf & VbCrLf
			
			Set objFile = objFSO.OpenTextFile(objFile.Path, ForReading, False)
 
			strUsers = ";"
			 
			While Not objFile.AtEndOfStream
			    strLine = objFile.ReadLine
			    If strLine <> "" Then
				    arrLine = Split(LCase(strLine), ",")
				    objData.AddNew
				    objData("Username") = Trim(arrLine(0))
				    objData("DateTime") = Trim(arrLine(1)) & " " & Trim(arrLine(2))
				    objData("DC") = Trim(arrLine(3))
					objData("IPAddress") = Trim(arrLine(4))
				    objData.Update
				    If strUsers = "" Then
				    	strUsers = arrLine(0) & ";"
				    Else
				    	If InStr(strUsers, ";" & arrLine(0) & ";") = 0 Then strUsers = strUsers & arrLine(0) & ";"
				    End If
				End If
			Wend
			 
			objFile.Close
			 
			If Left(strUsers, 1) = ";" Then strUsers = Mid(strUsers, 2)
			If Right(strUsers, 1) = ";" Then strUsers = Left(strUsers, Len(strUsers) - 1)
 
		End If
	Next
	For Each strUser In Split(strUsers, ";")
		strUserDN = Get_LDAP_User_Properties("user", "samAccountName", strUser, "distinguishedName")
		objData.Filter = "Username='" & strUser & "'"
		objData.MoveFirst
		While Not objData.EOF
			objUsers.Filter = ""
			If Not objUsers.EOF Then objUsers.MoveFirst
			objUsers.Filter = "Username='" & strUser & "' AND DistinguishedName='" & strUserDN & "' AND IPAddress='" & objData("IPAddress") & "'"
			On error resume next
		    If objUsers.EOF Then
			    objUsers.AddNew
			    objUsers("Username") = strUser
			    objUsers("DistinguishedName") = strUserDN
			    objUsers("IPAddress") = objData("IPAddress")
			    objUsers("AuthFailCount") = 1
			    objUsers.Update
			Else
				objUsers("AuthFailCount") = objUsers("AuthFailCount") + 1
			End If
			objData.MoveNext
		Wend
	Next
	objUsers.Filter = ""
	If Not objUsers.EOF Then objUsers.MoveFirst
	While Not objUsers.EOF
		If objUsers("AuthFailCount") >= AuthFailThreshold Then
			boolThresholdReached = True
			strBody = strBody & VbCrLf & "WARNING: " & objUsers("Username") & " (" & objUsers("DistinguishedName") & ") has failed Authentication on " & objUsers("IPAddress") & " " & objUsers("AuthFailCount") & " times."
			WScript.Echo "WARNING: " & objUsers("Username") & " (" & objUsers("DistinguishedName") & ") has failed Authentication on " & objUsers("IPAddress") & " " & objUsers("AuthFailCount") & " times."
		Else
			WScript.Echo objUsers("Username") & " (" & objUsers("DistinguishedName") & ") has failed Authentication on " & objUsers("IPAddress") & " " & objUsers("AuthFailCount") & " times."
			strReport = strReport & objUsers("Username") & " (" & objUsers("DistinguishedName") & ") has failed Authentication on " & objUsers("IPAddress") & " " & objUsers("AuthFailCount") & " times."
		End If
		objUsers.MoveNext
	Wend
Else
	WScript.Echo VbCrLf & VbCrLf & "Invalid date entered. Exiting script."
	strReport = strReport & VbCrLf & VbCrLf & "Invalid date entered. Exiting script."
End If
' Now send the file
If boolThresholdReached = True Then
	SendEmail strServer, strTo, strFrom, strSubject, strBody
	WScript.Echo VbCrLf & VbCrLf & strBody & VbCrLf & VbCrLf
	strReport = strReport & VbCrLf & VbCrLf & strBody & VbCrLf & VbCrLf
	WScript.Echo "Email has been sent."
	strReport = strReport & "Email has been sent."
Else
	WScript.Echo "The Auth failure threshold has not been reached."
	strReport = strReport & "The Auth failure threshold has not been reached."
End If
 
'Creates results file
'//////////////////////////////////////////////////////////////////////////////////////
strReportFile = "\\test-server\logs\AuthFailure-ThresholdReports\Auth-Failure.Threshold.Report.txt"
 
' -- The heart of the create file script -------------
' -- Creates the file using the value of strReportFile
' ----------------------------------------------------
Set objFile = objFSO.CreateTextFile(strReportFile, False)
objFile.Write strReport
objFile.Close
WScript.Echo strReportFile & " has been created."
' End of FileSystemObject example: NewFile VBScript
'////////////////////////////////End Create Text File//////////////////////////////////
 
WScript.Echo VbCrLf & VbCrLf & "Done"
 
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
      
      ' This is a custom function that connects to the Active Directory, and returns the specific
      ' Active Directory attribute value, of a specific Object.
      ' strObjectType: usually "User" or "Computer"
      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
      '				It filters the results by the value of strObjectToGet
      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
      '				For example, if you are searching based on the user account name, strSearchField
      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
      '				the home folder path, as defined by the AD, for a specific user, this would be
      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
      '				user and get your own parameters from them, then use "ADsPath" as a return string,
      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
      
      ' Now we're checking if the user account passed may have a domain already specified,
      ' in which case we connect to that domain in AD, instead of the default one.
      If InStr(strObjectToGet, "\") > 0 Then
            arrGroupBits = Split(strObjectToGet, "\")
            strDC = arrGroupBits(0)
            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
            strObjectToGet = arrGroupBits(1)
      Else
      ' Otherwise we just connect to the default domain
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDNSDomain = objRootDSE.Get("defaultNamingContext")
      End If
 
      strBase = "<LDAP://" & strDNSDomain & ">"
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set adoConnection = CreateObject("ADODB.Connection")
      adoConnection.Provider = "ADsDSOObject"
      adoConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = adoConnection
 
 
      ' Filter on user objects.
      'strFilter = "(&(objectCategory=person)(objectClass=user))"
      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
 
      ' Comma delimited list of attribute values to retrieve.
      strAttributes = strCommaDelimProps
      arrProperties = Split(strCommaDelimProps, ",")
 
      ' Construct the LDAP syntax query.
      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
      adoCommand.CommandText = strQuery
      ' Define the maximum records to return
      adoCommand.Properties("Page Size") = 100
      adoCommand.Properties("Timeout") = 30
      adoCommand.Properties("Cache Results") = False
 
      ' Run the query.
      Set adoRecordset = adoCommand.Execute
      ' Enumerate the resulting recordset.
      strReturnVal = ""
      Do Until adoRecordset.EOF
          ' Retrieve values and display.    
          For intCount = LBound(arrProperties) To UBound(arrProperties)
                If strReturnVal = "" Then
                      strReturnVal = adoRecordset.Fields(intCount).Value
                Else
                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
                End If
          Next
          ' Move to the next record in the recordset.
          adoRecordset.MoveNext
      Loop
 
      ' Clean up.
      adoRecordset.Close
      adoConnection.Close
      Get_LDAP_User_Properties = strReturnVal	  
End Function
 
'////////////////////////////////Mail Function/////////////////////////////////////////
Sub SendEmail(strServer, strTo, strFrom, strSubject, strBody)
	Dim objMessage
	
	Set objMessage = CreateObject("CDO.Message")
	objMessage.To = strTo
	objMessage.From = strFrom
	objMessage.Subject = strSubject
	objMessage.TextBody = strBody
 
	'==This section provides the configuration information for the remote SMTP server.
	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	'Name or IP of Remote SMTP Server
	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
	'Server port (typically 25)
	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25	
	objMessage.Configuration.Fields.Update
	'==End remote SMTP server configuration section==
 
	objMessage.Send
	Set objMessage = Nothing
End Sub

Select allOpen in new window