asked on

Archive folders with script

Hi,
The production software that I'm using creates a folder on a weekly basis that contains log files. The folder is named based on the creation date i.e. 15082008. So after two months the folder structure will look as follows:

01072008
07072008
14072008
21072008
28072008
05082008
12082008
19082008
26082008

What I would like to achieve is to automatically archive these folders on a monthly basis. The name of the archive must be (month)(year) i.e. 082008.zip or rar or whatever. So the script must basically be able to run against a specific folder, take all the folders where the last 6 characters of the folder name matches and archive these folders together and name the archive based on the last 6 characters.
Any ideas would be appreciated!

Shift-3

Paste the script below into a text file with a .vbs extension. Customize the value of the strFolder variable with the location of the folder containing the log folders. Running it will create a zip file containing all folders whose names end with last month.

Uncomment line 25 to delete the folders after zipping them.

strFolder = "c:\logs"
 
dtmLastMonth = DateAdd("m", -1, Now)
strMonth = Month(dtmLastMonth)
strYear = Year(dtmLastMonth)
 
If Len(strMonth) = 1 Then
    strMonth = "0" & strMonth
End If
 
strTarget = strMonth & strYear
strZip = strFolder & "\" & strTarget & ".zip"
 
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 
Set colSubfolders = objWMIService.ExecQuery _
    ("Associators of {Win32_Directory.Name='" & strFolder & "'} " _
        & "Where AssocClass = Win32_Subdirectory " _
            & "ResultRole = PartComponent")
 
For Each objFolder in colSubfolders
    If Right(objFolder.FileName, 6) = strTarget Then
        ZipFile objFolder.Name, strZip
        Set objFSO = CreateObject("Scripting.FileSystemObject")  
        'objFSO.DeleteFolder objFolder.Name        
    End If
Next
 
 
Sub ZipFile(strFileToZip, strArchive)
    Set objFSO = CreateObject("Scripting.FileSystemObject")  
    
    If Not objFSO.FileExists(strArchive) Then
        Set objTxt = objFSO.CreateTextFile(strArchive, ForWriting)
        objTxt.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
        objTxt.Close
    End If
 
    Set objApp = CreateObject( "Shell.Application" )
 
    intCount = objApp.NameSpace(strArchive).Items.Count + 1
 
    objApp.NameSpace(strArchive).CopyHere strFileToZip
 
    Do Until objApp.NameSpace(strArchive).Items.Count = intCount
        WScript.Sleep 200
    Loop
End Sub

Open in new window

AmazingTech

Something like this?

Uses WinRAR.

SETLOCAL ENABLEDELAYEDEXPANSION
Set ArchiveFolder=C:\Files
Set BackupFolder=C:\Backup
Set ArchiveProgram="C:\Program Files\WinRAR\WinRar.exe" a -r %BackupFolder%\
 
IF NOT EXIST "%BackupFolder%" MD "%BackupFolder%"
 
Set /p Month=Please enter the month and year to backup (mmyyyy): 
 
IF NOT EXIST "%ArchiveFolder%\*%Month%" (
    ECHO No archive folders found for month %month%
    GOTO :EOF
)
 
FOR /F "Tokens=*" %%a in ('dir /ad /b "%ArchiveFolder%\*%Month%"') do Set BackupFolders=!Backupfolders!%ArchiveFolder%\%%a + 
 
%ArchiveProgram%%month%.rar !BackupFolders:~0,-2!

Open in new window

avdvyver1

ASKER

Hi Shift-3,

Your script works like a charm but I made a stupid mistake on my request ... the date format is not mmyyyy, its yyyymm ... so please can you modify the script accordingly? Sorry about this ... the scripts works 100% when I rename the folders.
So the structure would look like this:

20080701
20080708
20080715
etc.

Thanks!!

ASKER CERTIFIED SOLUTION

Shift-3

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

avdvyver1

ASKER

Thanks!!

Rhodan

Hi Shift-3,

Regarding your last post in this question, when I run your amended script, I get the following error:

Line: 45
Char: 5
Error: Object required: 'objApp.NameSpace(...)'
Code: 800A01A8
Source: Microsoft VBScript runtime error

Please advise? I have changed the location to the correct location, and I have folders with the same YYYYMMDD format.

Cheers

Shift-3

That error can occur if the files being zipped are very large. I later revised the ZipFile subroutine to correct this.

Try substituting the subroutine from this question.

Rhodan

Shift-3,

Thanks for the quick reply. It started off working fine, but then when it got to around the 11th folder, it crashed with this error:

Line: 25
Char: 9
Error: Path not found
Code: 800A004C
Source: Microsoft VBScript runtime error

I am using the code above and replaced the sub routine as you mentioned. It is deleting the folders as it zips them.

Thanks

Rhodan

I've run it a couple of times and now it seems to work without crashing ... strange.

Is there a way to have the zip files placed elsewhere when they are created?

Also, can this be set as a scheduled task and run in the background?