Vbscript Compress Logs by Month

Hi,

Currently I have the following script to compress the log from one folder. I would like to update this script to read the strRoot from one .txt file with all locations that I would like to compress. How can I adapt the script? because I would like specify which folders I will compress with this script from a txt file.

This is the script:
strRoot = "F:\Logs\IIS"
strExt = "txt"
strExt1 = "log"
blnDeleteOriginals = True
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
DoFolder strRoot
 
Sub DoFolder(strFolder)
    Set objFolder = objFSO.GetFolder(strFolder)

 
    ' Process all files in this folder
    For Each objFile In objFolder.Files
        strFile = objFile.Path
        strFileExt = objFSO.GetExtensionName(strFile)
 
        If (LCase(strFileExt) = LCase(strExt)) Or (LCase(strFileExt) = LCase(strExt1)) Then
            dtmFile = objFile.DateLastModified
            strZIP = strFolder & "\" & MonthName(Month(dtmFile)) & Year(dtmFile) & ".zip"
            ZipFile strFile, strZip
 
            If blnDeleteOriginals and objFile.DateLastModified < (Date() - 1)  Then
                objFile.Delete True
            End If
        End If
    Next
 
    ' Process all subfolders in this folder
    Set objSubFolders = objFolder.SubFolders
    If objSubFolders.Count > 0 Then
        For Each objSubFolder in objSubFolders
            DoFolder objSubFolder.Path
        Next
    End If
 
End Sub
 
Sub ZipFile(strFileToZip, strArchive)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    If Not objFSO.FileExists(strArchive) Then
        Set objTxt = objFSO.CreateTextFile(strArchive)
        objTxt.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
        objTxt.Close
    End If
 
    WScript.Sleep 2000
    Set objApp = CreateObject("Shell.Application")
    intCount = objApp.NameSpace(strArchive).Items.Count + 1
    objApp.NameSpace(strArchive).CopyHere strFileToZip
 
    Do
        WScript.Sleep 200
        Set objNameSpace = objApp.NameSpace(strArchive)
 
        If Not objNameSpace Is nothing Then
            If objNameSpace.Items.Count = intCount Then
                Exit Do
            End If
        End If
    Loop
End Sub

Open in new window

LVL 1
Gonzalo BecerraSharePoint - Technical Lead for Operations & Engineering Team - Superrvising AssociateAsked:
Who is Participating?
 
Bill PrewCommented:
I think this should handle that, just update the path to the new txt file near the top.

' Define needed constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2

strInFile = "C:\temp\folders.txt"
strExt = "txt"
strExt1 = "log"
blnDeleteOriginals = True
 
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Open input file
Set objInfile = objFSO.OpenTextFile(strInfile, ForReading, False, TriStateUseDefault)

' Read input file line by line
Do While Not objInfile.AtEndOfStream
   strRoot = objInfile.ReadLine
   DoFolder strRoot
Loop

' Cleanup and end
objInfile.Close

 
Sub DoFolder(strFolder)
    Set objFolder = objFSO.GetFolder(strFolder)
 
    ' Process all files in this folder
    For Each objFile In objFolder.Files
        strFile = objFile.Path
        strFileExt = objFSO.GetExtensionName(strFile)
 
        If (LCase(strFileExt) = LCase(strExt)) Or (LCase(strFileExt) = LCase(strExt1)) Then
            dtmFile = objFile.DateLastModified
            strZIP = strFolder & "\" & MonthName(Month(dtmFile)) & Year(dtmFile) & ".zip"
            ZipFile strFile, strZip
 
            If blnDeleteOriginals and objFile.DateLastModified < (Date() - 1)  Then
                objFile.Delete True
            End If
        End If
    Next
 
    ' Process all subfolders in this folder
    Set objSubFolders = objFolder.SubFolders
    If objSubFolders.Count > 0 Then
        For Each objSubFolder in objSubFolders
            DoFolder objSubFolder.Path
        Next
    End If
 
End Sub
 
Sub ZipFile(strFileToZip, strArchive)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    If Not objFSO.FileExists(strArchive) Then
        Set objTxt = objFSO.CreateTextFile(strArchive)
        objTxt.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
        objTxt.Close
    End If
 
    WScript.Sleep 2000
    Set objApp = CreateObject("Shell.Application")
    intCount = objApp.NameSpace(strArchive).Items.Count + 1
    objApp.NameSpace(strArchive).CopyHere strFileToZip
 
    Do
        WScript.Sleep 200
        Set objNameSpace = objApp.NameSpace(strArchive)
 
        If Not objNameSpace Is nothing Then
            If objNameSpace.Items.Count = intCount Then
                Exit Do
            End If
        End If
    Loop
End Sub

Open in new window

~bp
0
 
Gonzalo BecerraSharePoint - Technical Lead for Operations & Engineering Team - Superrvising AssociateAuthor Commented:
Thank you, I think something is missing or not working I'm executing with results:

Result:
C:\Temp>cscript zip.vbs
Microsoft (R) Windows Script Host Version 5.7
Copyright (C) Microsoft Corporation. All rights reserved.


C:\Temp>

Open in new window


The script is not doing the zip on the files I added the msgbox here and is reading ok the content on the folders.txt but I don't know is not compressing properly the files in the folder.

' Read input file line by line
Do While Not objInfile.AtEndOfStream
   strRoot = objInfile.ReadLine
   msgbox strroot
   DoFolder strRoot
Loop
0
 
Gonzalo BecerraSharePoint - Technical Lead for Operations & Engineering Team - Superrvising AssociateAuthor Commented:
Sorry is working perfect!! i miss to change the extension of the files to compress.


Thank you very much for your help!!
0
 
Bill PrewCommented:
Great, glad that helped, thanks for the feedback.

~bp
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.