Help with a vbs file

Posted on 2009-04-05
Last Modified: 2013-11-25
I have a script below that has a couple of problems.
What I am trying to do is to zip up log files (that are older than 5 days old) into a single zip.
Problems that I have are....
It reopens the zip file for each file. I'd like to open the program once and have it zip them all.
It zips them with their full file paths. I want 1.log, 2.log, 3.log etc but each one zips as folder\folder\folder\folder\folder\1.log

I thought if I did a dir > filelist.txt then I could just pass filelist.txt to 7za but how do I only DIR the files that are > 5 days old?

 '' This script will find logs that are more than X days old and '' 

 '' compress them.                                              '' 


 Option Explicit 


 Dim objFSO, objFolder, objFiles, objShell 

 Dim file, fileExt, fileName, strCommand, strRun, strFile 

 Dim Folder, Extension, DaysOld 

 Dim ZipFile


 ZipFile = Day(Date) & Month(Date) & Year(Date) & ".zip"




 Folder = "\\servername\T1\F1\data\log\LogTester"      'Folder to look in 

 Extension = "log"        'Extension of files you want to zip 

 DaysOld = 5        'Zip files older than this many days 



 'Create object for playing with files 

 Set objFSO = CreateObject("Scripting.FileSystemObject") 


 'Create shell object for running commands 

 Set objShell = wscript.createObject("") 


 'Set folder to look in 

 Set objFolder = objFSO.GetFolder(Folder) 


 'Get files in folder 

 Set objFiles = objFolder.Files 


 'Loop through the files 

 For Each file in objFiles 

   fileName = Split(file.Name, ".") 

   fileExt = fileName(UBound(fileName)) 

   'See if it is the type of file we are looking for 

   If fileExt = Extension Then 

     'See if the file is older than the days chosen above 

     If DateDiff("d", file.DateLastModified, Now()) >= DaysOld Then 

       'objFSO.MoveFile file, "\\servename\T1\F1\data\log\logtester\files2Zip\"

       strFile = file.path

      ' strCommand = "7za -mx=9 a \\servename\T1\F1\data\log\logtester\" & ZipFile & strFile 

      strCommand = "7za -mx=9 a " & ZipFile & strFile 

       strRun = objShell.Run(strCommand, 0, True) 

       'wscript.echo strCommand 


     End If 


   End If 




       'wscript.echo "Deleted " & strFile 


 Set objFiles = Nothing 

 Set objFolder = Nothing 

 Set objFSO = Nothing 

 Set objShell = Nothing 


Open in new window

Question by:QPR
  • 5
  • 4
LVL 38

Accepted Solution

Shift-3 earned 500 total points
ID: 24077796
Here is a way to do it without 7zip, using the built-in zip functionality.

Paste the script below into a text file with a .vbs extension.  Customize the value of the strFolder variable on line 1 with the location of the folder containing the files.  Customize the value of the strExt variable on line 2 with the file extension to search for.  Customize the value of the intDays variable on line 3 with the number of days' worth of files to retain.

Running the script will zip files over the specified number of days old.  It will also echo their paths.  When you have tested it successfully and are certain it is finding the right files, remove the apostrophe from line 22 to delete them.

strFolder = "\\servername\T1\F1\data\log\LogTester"

strExt = "log"

intDays = 5

strYear = Year(Now)

strMonth = Right("0" & Month(Now), 2)

strDay = Right("0" & Day(Now), 2)

strZip = strFolder & "\" & strYear & strMonth & strDay & ".zip"

On Error Resume Next


Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(strFolder)

For Each objFile in objFolder.Files

    strFileExt = objFSO.GetExtensionName(objFile.Path)


    If LCase(strFileExt) = LCase(strExt) And DateDiff("d", objFile.DateCreated, Now) > intDays Then

        ZipFile objFile.Path, strZip

        WScript.Echo objFile.Path

        'objFile.Delete True

    End If


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))


    End If

    Set objApp = CreateObject( "Shell.Application" )

    intCount = objApp.NameSpace(strArchive).Items.Count + 1

    objApp.NameSpace(strArchive).CopyHere strFileToZip



        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


End Sub

Open in new window

LVL 29

Author Comment

ID: 24081853
thanks, I'll check it out when back to work.
Out of curiousity, where is the bit that actually says I'm going to create a zipped file/archive?
All I see is CreateTextFile
LVL 38

Expert Comment

ID: 24081947
That's it.  A bare-bones zip archive is just a text file with those characters in it.  Once it's created you can copy files to it using the CopyHere method.

Note that this only works on Windows XP and newer, as 2000 didn't have built-in zip capability.
LVL 29

Author Comment

ID: 24101555
it has a compression ratio of 0%
the size of the zip file is the same as the collective size of the text files in it.

How can I compress?
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

LVL 29

Author Comment

ID: 24101946
cancel that, turns out the files I tested on were gobbldegook and not plain text. Test 2 with plain text files and it works perfectly.
One thing tho...
What does
If Not objFSO.FileExists(strArchive) Then
        Set objTxt = objFSO.CreateTextFile(strArchive)
        objTxt.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
    End If

the objTxt.Write line doing?
LVL 38

Expert Comment

ID: 24103529
It's adding a series of ANSI characters to the file.  See these pages for more information:
LVL 29

Author Comment

ID: 24103953
thanks but why/where?
I don't see "pk" anywhere in the title or the logs being zipped?
LVL 38

Expert Comment

ID: 24104003
The PK stands for Phil Katz who originally created the .zip format.  The string is the file's header, containing its magic number.
LVL 29

Author Comment

ID: 24104080
I see (I think :-)
Thanks for sticking with me and explaining... last thing then I'll leave you alone.
So, this info is necessary in the file header so that OS/programs know how to store the data?
Sorry, this is all new to me being a SQL person.

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

This article shows how to make a Windows 7 gadget that extends its U/I with a flyout panel -- a window that pops out next to the gadget.  The example gadget shows several additional techniques:  How to automatically resize a gadget or flyout panel t…
As more and more people are shifting to the latest .Net frameworks, the windows presentation framework is gaining importance by the day. Many people are now turning to WPF controls to provide a rich user experience. I have been using WPF controls fo…
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA.…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now