I have wrote a vbscript to query OldLogfiles (6 Months old) and LargeLogfiles (Files Morethan 100MB) from C drive of the server and delete OldLogfiles l.But the script not seems to be working fine.The script is executing and I am able to get entire log file details from C drive,But what I really want is the log file which is older than 180 days should print the results and Need to delete those files from C drive.its not giving that output.Also it should print theĀ LargeLogfiles details too.

Can anyone help me to fix the issue with below vbscript ?

strComputer = "."
Dim objFile,iDaysOld,item,objFSO,dateTime
Dim FileName,FileName1,Logs,GetFile,file
iDaysOld = 180
Set dateTime = CreateObject("WbemScripting.SWbemDateTime")
Set wmi = GetObject("winmgmts:\\.\root\cimv2")
Set files = wmi.ExecQuery("Select * from CIM_DataFile Where Extension='log' AND Drive='C:'")
For Each file in files
    If LCase(Right(Cstr(File.Name), 3)) = "log" Then
        FileName1 = Trim(File.Name)
        FileName = (File.Name & "," & FileName)
   '     wscript.echo FileName
        If file.LastModified < (Date() - iDaysOld) Then
' oFile.Delete(True) 
            wscript.echo "tr_Oldlogfiles=" &FileName
        End If 
    End If 
Next
0 Comments   [ + ] Show Comments

Comments

Please log in to comment

Answers

0
You're trying to subtract 180 from today's date but not specified what unit you're subtracting. Is it days? Months? Seconds?Use DateDiff instead.
Answered 04/06/2016 by: VBScab
Red Belt

  • I80days old file need to print and then need to delete those files. Even I have tried Date Diff here.But it gives "Microsoft VBScript runtime error: Type mismatch: '[string: "20150622114321.69096"]'"

    strComputer = "."

    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

    Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile Where Extension = 'log' AND (Drive = 'C:')")


    Dim objFile,iDaysOld,item,objFSO
    Dim FileName,FileName1,Logs,GetFile,oFolder

    iDaysOld = 180

    For Each objFile in colFiles

    If LCase(Right(Cstr(objFile.Name), 3)) = "log" Then

    If DateDiff("d", objFile.LastModified, Date) >= iDaysOld Then

    FileName1 = Trim(objFile.Name)

    FileName = (objFile.Name & "," & FileName)

    wscript.echo "test_Oldlogfiles=" &FileName


    ' oFile.Delete(True)
    End If


    End If

    Next
Please log in to comment
0

This is a script I cobbled together ages ago which uses a "shell" I created to be a generic "do stuff with files" script, hence its somewhat convoluted approach. However, it works! So, you pass a bunch of arguments to it like this:

cscript ThisScript.VBS folder_to_search_in extension_of_file_to_process age_of_files_in_days
e.g. cscript ThisScript.VBS c:\windows\temp LOG 180

Then here's the script itself:

'// Creates a dictionary containing details of files in and under a directory.
'// Drop a folder on this script or browse for it.
Option Explicit

Dim blnResult
Dim intIndex
Dim strMsg
Dim objFSO
Dim objWSHShell
Dim strScriptFullName
Dim objDictionary
Dim strOut
Dim intAge
Dim strMatchCriteria

Const strNameSeparator  = "|"
Const strBrowseForFolderTitle = "Select a folder to process"

strScriptFullName  = WScript.ScriptFullName

Set objFSO    = CreateObject("Scripting.FileSystemObject")
Set objWSHShell   = CreateObject("Shell.Application")
Set objDictionary  = CreateObject("Scripting.Dictionary")

Call Main

Set objDictionary  = Nothing
Set objWSHShell   = Nothing
Set objFSO    = Nothing

Sub Main
 Dim objFolder
 Dim strFolder
 Dim strExtension
 
 '// Get the folder you want info on
 On Error Resume Next
 If WScript.Arguments.Count > 0 Then
  strFolder  = WScript.Arguments(0)
  strExtension = WScript.Arguments(1)
  intAge  = WScript.Arguments(2)
  strMatchCriteria= WScript.Arguments(3)
 Else
  strFolder  = BrowseForFolder(strBrowseForFolderTitle)
 End If
 On Error Goto 0
 
 If Len(strFolder) = 0 Then
  Exit Sub
 End If
 
 If Len(strExtension) = 0 Then
  strExtension = ".MSI"
 End If
 
 If Len(intAge) = 0 Then
  intAge  = 365
 Else
  intAge  = CInt(intAge)
 End If
 
 If Len(strMatchCriteria) = 0 Then
  strMatchCriteria = "A" '// Use AccessedDate as default
 End If
 
 Call HandleExtension(strExtension, strFolder)
 
End Sub

Sub HandleExtension(ByVal strExt, ByVal strSourceFolder)
 Dim arrDictItems
 Dim arrDictKeys
 Dim strKey
 Dim strItem
 
 '// Don't even bother to start if the destination folder doesn't exist
 If Not objFSO.FolderExists(strSourceFolder) Then
  strMsg  = "The source folder '" & strSourceFolder & "' does not exist."
  MsgBox strMsg, vbOKOnly + vbExclamation
  Exit Sub
 End If
 
 '// Because I decided to call the extension types one by one,
 '// thus using only one key, rather than x number
 '// (where 'x' is the number of extensions to be processed)
 '// we need to empty the dictionary
 On Error Resume Next
 objDictionary.RemoveAll
 On Error Goto 0
 
 strOut = ""
 Call RecurseExtensions(objFSO.GetFolder(strSourceFolder), strExt)
 'Call RecurseFiles(objFSO.GetFolder(strSourceFolder))
 
 If IsEmpty(objDictionary) Then
  Exit Sub
 End If
 
 '// Now that we have a dictionary, we can process the items in it
 With objDictionary
  arrDictKeys = .Keys
  arrDictItems = .Items
  
  For intIndex = 0 To .Count - 1
   strKey = arrDictKeys(intIndex)
   strItem = .Item(arrDictKeys(intIndex))

   'WScript.Echo "Key = " & strKey & " Item = "  & strItem
   '// The data looks like this:
   '// Path_to_file, Name_of_file, Size, File type
   '//  separator (see strNameSeparator)
   '// Path_to_file, Name_of_file, Size, File type
   '// etc
   
   '// This next call is what makes this script reasonably generic:
   '// just pass the data to a function which does what you want it to do
   
   blnResult = StartProcessing(strItem)
  Next
 End With
End Sub

Function StartProcessing(ByVal strData)
 Dim arrData
 Dim objFile
 Dim strItem
 Dim strPath
 Dim strName
 Dim strSize
 Dim strType
 Dim strDateCreated
 Dim strDateModified
 Dim strDateAccessed
 Dim strSourceFile
 Dim strDestinationFile
 Dim strCheckDate
 
 '// NB!
 '// When the data gets here, it features an additional first element - the path.
 '// Thus, the index numbers all increase by 1 e.g. the file name is in index 1 rather than 0
 arrData    = Split(strData, strNameSeparator)
 
 QuickSortArray arrData, "(Split(X2)(5)) < (Split(X1)(5))"

 'DisplayResults "Sorted by date", arrData

 '// The data is now in ascending date order.
 '// Now we loop through, creating a new array for files which are OLDER than
 '// the maximum age flag we passed in.
 
 For intIndex = 0 To UBound(arrData)
  strItem  = arrData(intIndex)
  'WScript.Echo strItem
  
  '// Split the data into an array
  strPath  = Split(strItem, ",")(0)
  strName  = Split(strItem, ",")(1)
  strSize  = Split(strItem, ",")(2)
  strType  = Split(strItem, ",")(3)
  strDateCreated = Split(strItem, ",")(4)
  strDateModified = Split(strItem, ",")(5)
  strDateAccessed = Split(strItem, ",")(6)

  strSourceFile  = strPath & "\" & strName
  
  Select Case UCase(strMatchCriteria)
   Case "C"
    strCheckDate = strDateCreated
   Case "A"
    strCheckDate = strDateAccessed
  End Select
  
  If DateDiff("d", strCheckDate, Date) >= intAge Then
   strMsg = ""
   strMsg = strMsg & strPath & ","
   strMsg = strMsg & strName & ","
   strMsg = strMsg & strSize & ","
   strMsg = strMsg & strType & ","
   strMsg = strMsg & strDateCreated & ","
   strMsg = strMsg & strDateModified & ","
   strMsg = strMsg & strDateAccessed
   WScript.Echo strMsg
  End If
 Next

End Function

Sub RecurseExtensions(ByVal objFolderName, ByVal strExt)
 Dim objSubFolders
 Dim objSubFolder
 Dim objFolder
 Dim objFile
 Dim strDetails
 Dim intElement
 Dim strFolderName
 Dim strExtension
 
 strFolderName  = objFolderName.Path
 Set objFolder   = objWSHShell.Namespace(strFolderName)
 If Err.Number <> 0 Then
  Exit Sub
 End If
 
 '// Write the actual data elements for each file
 For Each objFile in objFolder.Items
  With objDictionary
   If InStr(objFile.Name, ".") Then
    strExtension = UCase(Mid(objFile.Name, InStrRev(objFile.Name, "." ) ) )
    If UCase(strExt) = UCase(strExtension) Then
     Call Say("Processing " & objFolder.GetDetailsOf(objFile, 0))
     If strOut <> "" Then
      strOut = strOut & strNameSeparator
     End If
     
     strOut   = strOut & strFolderName
     
     '// We're not interested in the rest of this junk, just:
     '// 0 Name   
     '// 1 Size   
     '// 2 Type   
     '// 3 Date modified  
     '// 4 Date created  
     '// 5 Date accessed  
     
     'For intElement = 0 to 37
     For intElement = 0 To 5
      If strOut <> "" Then
       strOut = strOut & ","
      End If
      strOut = strOut & Replace(objFolder.GetDetailsOf(objFile, intElement), ",", "")
     Next
     
     If Not .Exists(strExtension) Then
      .Add strExtension, strOut
     Else
      .Item(strExtension) = strOut
     End If
    End If
   End If
  End With
 Next
 
 '// Check for any sub-folders and recursively process them
 On Error Resume Next
 Set objSubFolders = objFolderName.SubFolders
 If Err.Number <> 0 Then
  strMsg = "Error " & Err.Number & " occured."
  If Len(Err.Description) > 0 Then
   strMsg = strMsg & vbCRLF & Err.Description
  End If
  WScript.Echo strMsg
 Else
  For Each objSubFolder in objSubFolders
   If LCase(objSubFolder.Name) <> "recycled" Then
    Call RecurseExtensions(objSubFolder, strExt)
   End If
  Next
 End If
 Err.Clear
 On Error Goto 0
 
 Set objFile  = Nothing
 Set objFolder   = Nothing
End Sub

Sub RecurseFiles(ByVal objFolderName)
 Dim objSubFolders
 Dim objSubFolder
 Dim objFolder
 Dim objFile
 Dim strOut
 Dim intElement
 Dim strFolderName
 
 strFolderName = objFolderName.Path
 Set objFolder  = objWSHShell.Namespace(strFolderName)
 If Err.Number <> 0 Then
  Exit Sub
 End If
 
 '// Write the actual data elements for each file
 For Each objFile in objFolder.Items
  Call Say("Processing " & objFolder.GetDetailsOf(objFile, 0))
  If strOut <> "" Then
   strOut  = strOut & vbCrLf
  End If
  
  strOut   = strOut & strFolderName
  
  '// We're not interested in the rest of this junk
  'For intElement = 0 to 37
  For intElement = 0 To 2
   If strOut <> "" Then
    strOut = strOut & ","
   End If
   strOut = strOut & Replace(objFolder.GetDetailsOf(objFile, intElement), ",", "")
  Next
  
  Call AddLineToDictionary(strOut)
  strOut = ""
 Next
 
 '// Check for any sub-folders and recursively process them
 Set objSubFolders = objFolderName.SubFolders
 For each objSubFolder in objSubFolders
  If LCase(objSubFolder.Name) <> "recycled" Then
   Call RecurseFiles(objSubFolder)
  End If
 Next
End Sub

Function BrowseForFolder(strPrompt)
 '// Uses "Shell.Application" (only present in Win98 and newer)
 '// to bring up a file/folder selection window. Falls back to an
 '// ugly input box under Win95.
 
 'Shell32.Shell SpecialFolder constants
 Const ssfPERSONAL   = 5   '// My Documents
 Const ssfDRIVES   = 17   '// My Computer
 Const ssfWINDOWS   = 36  '// Windows
 Const SFVVO_SHOWALLOBJECTS  = 1
 Const SFVVO_SHOWEXTENSIONS  = 2

 Const BIF_RETURNONLYFSDIRS  = &H0001
 Const BIF_EDITBOX   = &H0010
 Const BIF_VALIDATE   = &H0020
 Const BIF_NEWDIALOGSTYLE  = &H0040

 Dim objFolder
 Dim lngView
 Dim strPath
 
 If Instr(TypeName(objWSHShell), "Shell") = 0 Then
  BrowseForFolder = InputBox(strPrompt, "Select Folder", CreateObject("Scripting.FileSystemObject").GetParentFolderName(strScriptFullName))
  Exit Function
 End If

 lngView    = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS
 lngView    = lngView + BIF_NEWDIALOGSTYLE + BIF_VALIDATE + BIF_EDITBOX + BIF_RETURNONLYFSDIRS

 strPath    = ""
 
 Set objFolder    = objWSHShell.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
 Err.Clear
 
 On Error Resume Next
 strPath    = objFolder.ParentFolder.ParseName(objFolder.Title).Path

 '// An error occurs if the user selects a drive instead of a folder
 '// so handle it here
 Select Case Err.Number
  Case 0
   BrowseForFolder = strPath
  Case 424
   '// User probably selected a drive. Let's see.
   '// First, have a fall-back option
   BrowseForFolder = objFolder.Title

   strPath  = objFolder.Title
   If Len(strPath) > 0 Then
    intIndex = InStr(strPath, ":")
    If intIndex > 0 Then
     strPath = Mid(strPath, intIndex - 1, 2) & "\"
    End If
   End If
  Case Else
 End Select
 
 '// If the user *types (or pastes) in* an incorrect path, no error is raised
 '// so handle it here
 If Len(strPath) > 0 Then
  '// Only process if something was entered/selected
  If objFSO.FolderExists(strPath) Then
   BrowseForFolder = strPath
   Exit Function
  End If
   
  strMsg  = "The folder '" & strPath & "' does not exist."
  MsgBox strMsg, vbOKOnly + vbExclamation
  BrowseForFolder = ""
 End If
 On Error Goto 0
End Function

Sub Say(strMessage)
 If LCase(Right(WScript.FullName, 12)) = "\cscript.exe" Then
  WScript.Echo strMessage
 End If
End Sub

Sub AddLineToDictionary(ByVal strText)
 '// This routine was designed around AddLineToCSVFile so the string comes in as a CSV line.
 Dim strPath
 Dim strName
 Dim strType
 Dim strSize
 
 strPath    = Split(strText, ",")(0)
 strName    = Split(strText, ",")(1)
 strSize    = Split(strText, ",")(2)
 strType    = Split(strText, ",")(3)
 
 '// Include the path to make the key unique. Without it, subsequent keys wouldn't get added
 '// because the key would already exist. I leave the path in the item because I can use
 '// Split to get at it, rather than string manipulation of the key
 objDictionary.Add strPath & "\" & strName, strSize & strNameSeparator & strType & strNameSeparator & strPath
 
End Sub

Sub AddLineToCSVFile(ByVal strText)
 Dim objTextFile
 Const intForAppending   = 8
 Set objTextFile   = objFSO.OpenTextFile(Left(strScriptFullName, InstrRev(strScriptFullName, ".")) & "csv", intForAppending, True)
 
 With objTextFile
  .WriteLine strText
  .Close
 End With
End Sub

Function FileNameLikeMine(ByVal strFileExtension)
 '// Returns a file name the same as the script name
 '// except for the file extension.
 Dim strExtension
 
 strExtension    = strFileExtension
 If Len(strExtension) < 1 Then
  strExtension   = "txt"
 End If
 
 If strExtension = "." Then
  strExtension   = "txt"
 End If
 
 If Left(strExtension,1) = "." Then
  strExtension   = Mid(strExtension, 2)
 End If
 
 FileNameLikeMine   = Left(strScriptFullName, InstrRev(strScriptFullName, ".")) & strExtension
End Function

Sub WriteHeader
 strOut = "Path"
 '// We're not interested in the rest of this junk
 'For intElement = 0 To 37
 For intElement = 0 To 2
  If strOut <> "" Then
   strOut = strOut & ","
  End If
  
  With objFolder
   strOut = strOut & .GetDetailsOf(.Items, intElement)
  End With
 Next
End Sub

Sub QuickSortArray(ByVal aData(), ByVal strTestRelationship)
'***********************
' Purpose:  Sorts an array using the QuickSort method
'
' Inputs:  aData()   the array to be sorted.
'   strTestRelationship  a string representation of the boolean relationship of
'      two arbitrary array elements, X1 and X2. The relationship
'      is true if the elements are in the correct order.
'***********************

  Dim strTestFunction

  '// Create test function by adding function header and tail
  strTestFunction = "Function TestFunction(X1, X2) : TestFunction = " & strTestRelationship & " : End Function"

  '// Make TestFunction available
  ExecuteGlobal strTestFunction

  '// Now Call QSort  
  QSort aData, LBound(aData), UBound(aData)

End Sub 'QuickSort

'=====================

Sub QSort(ByVal aData, ByVal iaDataMin, ByVal iaDataMax)
  Dim Temp
  Dim Buffer
  Dim iaDataFirst
  Dim iaDataLast
  Dim iaDataMid

  iaDataFirst = iaDataMin                        '// Start current low and high at actual low/high
  iaDataLast = iaDataMax

  If iaDataMax <= iaDataMin Then Exit Sub        '// Error! 
  iaDataMid = (iaDataMin + iaDataMax) \ 2        '// Find the approx midpoint of the array

  Temp = aData(iaDataMid)                        '// Pick as a starting point (we are making
                                                 '// an assumption that the data *might* be
                                                 '// in semi-sorted order already!

  Do While (iaDataFirst <= iaDataLast)
      '// Comparison here
        Do While TestFunction(aData(iaDataFirst), Temp)
          iaDataFirst = iaDataFirst + 1
          If iaDataFirst = iaDataMax Then Exit Do
      Loop

      '// Comparison here
       Do While TestFunction(Temp, aData(iaDataLast))
          iaDataLast = iaDataLast - 1
          If iaDataLast = iaDataMin Then Exit Do
      Loop

      If (iaDataFirst <= iaDataLast) Then        '// If low is <= high then swap
          Buffer = aData(iaDataFirst)
          aData(iaDataFirst) = aData(iaDataLast)
          aData(iaDataLast) = Buffer
          iaDataFirst = iaDataFirst + 1 
          iaDataLast = iaDataLast - 1
      End If
  Loop

  If iaDataMin < iaDataLast Then                 '// Recurse if necessary
      QSort aData, iaDataMin, iaDataLast
  End If

  If iaDataFirst < iaDataMax Then                '// Recurse if necessary
      QSort aData, iaDataFirst, iaDataMax
  End If

End Sub '// QSort

Sub DisplayResults(ByVal Title, ByVal Data)
 Dim I
 Dim strTemp

 For I = 0 to UBound(Data)
  strTemp = strTemp & Data(i) & vbNewLine
 Next 'i
 MsgBox strTemp, vbOkOnly, Title
End Sub


Answered 04/06/2016 by: VBScab
Red Belt

  • Thanks for the script. I am very new to this scripting and I am trying to learn now.So I am unable to understand much from above script.
Please log in to comment
Answer this question or Comment on this question for clarity