Zip folders

[thec0dy]

I have a script that will zip folders based on the source and the output file. (MySource / MyTarget) I would like to have the MySource select all available folders in a certain root folder and zip each folder using the original name as the output.

For Example
20110117 is a folder in the root directory. I would like it to automatically zip to 20110117.zip. If there were additional folders in the root directory they too would be zipped in similar format.

------------------------------------------------------

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys

MySource = "C:\Test\20110117"
MyTarget = "C:\Test\20110117.zip"



MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next
Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")


'Create the basis of a zip file.
Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing
Set oApp = CreateObject("Shell.Application")


'Copy the files to the compressed folder
Set oFolder = oApp.NameSpace(MySource)
If Not oFolder Is Nothing Then
oApp.NameSpace(MyTarget).CopyHere oFolder.Items
End If
'Wait for compressing to begin, this was necessary on my machine
wScript.Sleep(5000)
'wait for lock to release
Set oFile = Nothing
On Error Resume Next
Do While (oFile Is Nothing)
'Attempt to open the file, this causes an Err 70, Permission Denied when the file is already open
Set oFile = oFileSys.OpenTextFile(MyTarget, ForAppending, False)
If Err.number <> 0 then
Err.Clear
wScript.Sleep 3000
End If
Loop
Set oFile=Nothing
Set oFileSys=Nothing

 

[guitarzan]

Something like this:

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
 
[s]MySource = "C:\Test\20110117"
MyTarget = "C:\Test\20110117.zip"[/s]

[COLOR=blue]Dim MySourcePath, fParentFolder, fldr
MySourcePath = "C:\Test"[/color]

MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(MyHex)
   MyBinary = MyBinary & Chr(MyHex(i))
Next
Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject") 

[COLOR=blue]Set fParentFolder = oFileSys.GetFolder(MySourcePath)

For Each fldr In fParentFolder.SubFolders

   MySource = fldr.Name
   MyTarget = fldr.Name & ".zip"[/color]

   'Create the basis of a zip file.
   Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
   oCTF.Write MyBinary
   oCTF.Close
   Set oCTF = Nothing
   Set oApp = CreateObject("Shell.Application")


   'Copy the files to the compressed folder
   Set oFolder = oApp.NameSpace(MySource)
   If Not oFolder Is Nothing Then
      oApp.NameSpace(MyTarget).CopyHere oFolder.Items
   End If
   'Wait for compressing to begin, this was necessary on my machine
   wScript.Sleep(5000)
   'wait for lock to release
   Set oFile = Nothing
   On Error Resume Next
   Do While (oFile Is Nothing)
      'Attempt to open the file, this causes an Err 70, Permission Denied when the file is already open
      Set oFile = oFileSys.OpenTextFile(MyTarget, ForAppending, False)
      If Err.number <> 0 then
         Err.Clear
         wScript.Sleep 3000
      End If
   Loop

[COLOR=blue]Next[/color]

Set oFile=Nothing
Set oFileSys=Nothing

 

[thec0dy]

You are awesome! Thank you very much!

 

[guitarzan]

You're welcome, glad it worked