Batch compressing many subfolders

Here is the outline of a batch file to do this, the specifics would have to be filled in for your particular dir structure:

REM Ziptree.bat
REM Assume you are in the top level directory to start.
REM This batch file assumes that there are only two levels of dirs
REM to process--same principle would apply however.

REM Assume that your subdirs are in the format A1, A2, A100, etc.
REM Change the format of this as needed.  Can also have multiple
REM filemasks (A*. B*. C*., etc).
for /d %%i in (A*.) do call :GO1 %%i

goto END

REM %1 is dir name
:GO1
cd %1
REM do your zip command line here
cd ..

:END

goto :EOF

Sorry, swap the

:END

and

goto :EOF

lines--they should be reversed.

Here is an example of how to do this with vbscript using winrar. Save it as as a vbs file (e.g. compress.vbs) and run it. I have done limited testing with it.




WinRarPath = "C:\Program Files\WinRAR\WinRAR.exe"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Directory = fnShellBrowseForFolderVB()

If Directory = "1" Then
  Msgbox "No Folder Was Selected"
  continue = 1
Else
  Selection = MsgBox("Compress all subfolders in " & Directory , 1, "Continue?")

  if Selection = 2 then
    continue = 1
  Else
    Set Folder = fso.GetFolder(Directory)
    Set Files = Folder.Files
    Set Folder = Folder.SubFolders
  End IF
End IF

If fso.FileExists(WinRarPath) = False Then
  Msgbox "Path to WinRar is not Valid"
  continue = 1
End IF

if continue <> 1 then
  For Each SubFolder in Folder

    Dim sDrive, sDir, sFname, sExt
    SplitPath SubFolder, sDrive, sDir, sFname, sExt

    switches = " -IBCK -INUL a -r " & """" & Directory & "\" & sFname & ".zip" & """" & " " & """" & sFname & "\*.*" & """"
    objShell.Run """" & WinRarPath & """" & switches & """"
  Next
End If


Sub SplitPath(ByVal sPath, ByRef sDrive, ByRef sDir, ByRef sFname, ByRef sExt)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  sDrive = fso.GetDriveName(sPath)
  sDir = Mid(fso.GetParentFolderName(sPath), Len(sDrive)+1) & "\"
  sFname = fso.GetBaseName(sPath)
  sExt = "." & fso.GetExtensionName(sPath)
  Set fso = Nothing
End Sub




function fnShellBrowseForFolderVB()
  dim objShell
  dim ssfDRIVES
  dim objFolder
 
  ssfDRIVES = 17
  set objShell = CreateObject("Shell.Application")
  set objFolder = objShell.BrowseForFolder(0, "Select folder", 0, ssfDRIVES)

  if (not objFolder is nothing) then
    Set objFolder = objFolder.Self
    objFolderPath = objFolder.Path
  end if

  if objFolderPath <> "" then
     fnShellBrowseForFolderVB = objFolderPath
  Else
     fnShellBrowseForFolderVB = 1
  End IF
end function

I forgot to say, when you first run the script it will ask you to select a folder. Select the folder that contains the sub-folders that you want to compress.

acsell - your solution seems to be perfect, however the .vbs file has at least one error - I can run it well, but it only makes few archives (much less than the number of sub-folders) and they are invalid/corrupt compressed files. Could you please correct/debug the code inside the vbs file ? Thank you a lot.

Sorry about that, it was quite late last night when I was writing it so I never had time to test it properly.

I think I know what the problem is so I will post back in a minute with the corrected code

Here is the ammended version. Let me know if you have any problems.







WinRarPath = "C:\Program Files\WinRAR\WinRAR.exe"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Directory = fnShellBrowseForFolderVB()

If Directory = "1" Then
  Msgbox "No Folder Was Selected"
  continue = 1
Else
  Selection = MsgBox("Compress all subfolders in " & Directory , 1, "Continue?")

  if Selection = 2 then
    continue = 1
  Else
    Set Folder = fso.GetFolder(Directory)
    Set Files = Folder.Files
    Set Folder = Folder.SubFolders
  End IF
End IF

If fso.FileExists(WinRarPath) = False Then
  Msgbox "Path to WinRar is not Valid"
  continue = 1
End IF

if continue <> 1 then
  For Each SubFolder in Folder

    Dim sDrive, sDir, sFname, sExt
    SplitPath SubFolder, sDrive, sDir, sFname, sExt

    switches = " -IBCK -INUL -ep1 a -r " & """" & Directory & "\" & sFname & ".zip" & """" & " " & """" & sDir & sFname
    objShell.Run """" & WinRarPath & """" & switches & """"
  Next
End If


Sub SplitPath(ByVal sPath, ByRef sDrive, ByRef sDir, ByRef sFname, ByRef sExt)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  sDrive = fso.GetDriveName(sPath)
  sDir = Mid(fso.GetParentFolderName(sPath), Len(sDrive)+1) & "\"
  sFname = fso.GetBaseName(sPath)
  sExt = "." & fso.GetExtensionName(sPath)
  Set fso = Nothing
End Sub




function fnShellBrowseForFolderVB()
  dim objShell
  dim ssfDRIVES
  dim objFolder
 
  ssfDRIVES = 17
  set objShell = CreateObject("Shell.Application")
  set objFolder = objShell.BrowseForFolder(0, "Select folder", 0, ssfDRIVES)

  if (not objFolder is nothing) then
    Set objFolder = objFolder.Self
    objFolderPath = objFolder.Path
  end if

  if objFolderPath <> "" then
     fnShellBrowseForFolderVB = objFolderPath
  Else
     fnShellBrowseForFolderVB = 1
  End IF
end function

ascell - the problem continues almost the same - the vbs file makes less archives than the number of sub-folders and they are invalid/corrupt compressed files (they always have a size = 215 KB and are invalid/corrupt)... :(

Do you have the latest version of WinRAR? I'm using version 3.51

What operating system are you using? Make sure you have the latest version of Windows Script

Windows XP and Windows 2000
http://www.microsoft.com/downloads/details.aspx?FamilyID=c717d943-7e4b-4622-86eb-95a22b832caa&DisplayLang=en

Windows 98, Windows Millennium Edition, and Windows NT 4.0 Genuine Windows download
http://www.microsoft.com/downloads/details.aspx?familyid=0A8A18F6-249C-4A72-BFCF-FC6AF26DC390&displaylang=en

>> however the .vbs file has at least one error

What is the error message?

Does this work any better?



WinRarPath = "C:\Program Files\WinRAR\WinRAR.exe"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Directory = fnShellBrowseForFolderVB()

If Directory = "1" Then
  Msgbox "No Folder Was Selected"
  continue = 1
Else
  Selection = MsgBox("Compress all subfolders in " & Directory , 1, "Continue?")

  if Selection = 2 then
    continue = 1
  Else
    Set Folder = fso.GetFolder(Directory)
    Set Files = Folder.Files
    Set Folder = Folder.SubFolders
  End IF
End IF

If fso.FileExists(WinRarPath) = False Then
  Msgbox "Path to WinRar is not Valid"
  continue = 1
End IF

if continue <> 1 then
  For Each SubFolder in Folder

    Dim sDrive, sDir, sFname, sExt
    SplitPath SubFolder, sDrive, sDir, sFname, sExt

    switches = " -IBCK -INUL -ep1 a -r " & """" & Directory & "\" & sFname & ".zip" & """" & " " & """" & Directory & "\" & sFname
msgbox """" & WinRarPath & """" & switches & """"
    objShell.Run """" & WinRarPath & """" & switches & """"
  Next
End If


Sub SplitPath(ByVal sPath, ByRef sDrive, ByRef sDir, ByRef sFname, ByRef sExt)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  sDrive = fso.GetDriveName(sPath)
  sDir = Mid(fso.GetParentFolderName(sPath), Len(sDrive)+1) & "\"
  sFname = fso.GetBaseName(sPath)
  sExt = "." & fso.GetExtensionName(sPath)
  Set fso = Nothing
End Sub




function fnShellBrowseForFolderVB()
  dim objShell
  dim ssfDRIVES
  dim objFolder
 
  ssfDRIVES = 17
  set objShell = CreateObject("Shell.Application")
  set objFolder = objShell.BrowseForFolder(0, "Select folder", 0, ssfDRIVES)

  if (not objFolder is nothing) then
    Set objFolder = objFolder.Self
    objFolderPath = objFolder.Path
  end if

  if objFolderPath <> "" then
     fnShellBrowseForFolderVB = objFolderPath
  Else
     fnShellBrowseForFolderVB = 1
  End IF
end function

sorry, I forgot to remove the message box in the above code.





WinRarPath = "C:\Program Files\WinRAR\WinRAR.exe"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Directory = fnShellBrowseForFolderVB()

If Directory = "1" Then
  Msgbox "No Folder Was Selected"
  continue = 1
Else
  Selection = MsgBox("Compress all subfolders in " & Directory , 1, "Continue?")

  if Selection = 2 then
    continue = 1
  Else
    Set Folder = fso.GetFolder(Directory)
    Set Files = Folder.Files
    Set Folder = Folder.SubFolders
  End IF
End IF

If fso.FileExists(WinRarPath) = False Then
  Msgbox "Path to WinRar is not Valid"
  continue = 1
End IF

if continue <> 1 then
  For Each SubFolder in Folder

    Dim sDrive, sDir, sFname, sExt
    SplitPath SubFolder, sDrive, sDir, sFname, sExt

    switches = " -IBCK -INUL -ep1 a -r " & """" & Directory & "\" & sFname & ".zip" & """" & " " & """" & Directory & "\" & sFname
    objShell.Run """" & WinRarPath & """" & switches & """"
  Next
End If


Sub SplitPath(ByVal sPath, ByRef sDrive, ByRef sDir, ByRef sFname, ByRef sExt)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  sDrive = fso.GetDriveName(sPath)
  sDir = Mid(fso.GetParentFolderName(sPath), Len(sDrive)+1) & "\"
  sFname = fso.GetBaseName(sPath)
  sExt = "." & fso.GetExtensionName(sPath)
  Set fso = Nothing
End Sub




function fnShellBrowseForFolderVB()
  dim objShell
  dim ssfDRIVES
  dim objFolder
 
  ssfDRIVES = 17
  set objShell = CreateObject("Shell.Application")
  set objFolder = objShell.BrowseForFolder(0, "Select folder", 0, ssfDRIVES)

  if (not objFolder is nothing) then
    Set objFolder = objFolder.Self
    objFolderPath = objFolder.Path
  end if

  if objFolderPath <> "" then
     fnShellBrowseForFolderVB = objFolderPath
  Else
     fnShellBrowseForFolderVB = 1
  End IF
end function

acsell - I am using Windows XP Service Pack 2 (updated everyday by automatic updates) and WinRar 3.51. The last vbs code had one improvement - now it makes as many archives as the number of sub-folders (rather than making less), but they still being invalid/corrupt compressed files (and they still always have the same size = 215 KB). There is no error messages (no error popup/message box). I said that the code has errors because the final result is bad, and I think that is possible to correct code inside vbs file. I suggest you to test your vbs file in your computer, so you will see all the problems, and you will be able to correct them. Let me thank you for being patient !

That's strange. I've tried it on 3 different systems and it's working fine here.

This version is the same as the above but it will create two log files at the end. Could you post the content (or if they are too large, part of the content). They should tell me what is happening to cause it to fail.

Thanks, Jon







WinRarPath = "C:\Program Files\WinRAR\WinRAR.exe"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Directory = fnShellBrowseForFolderVB()

If Directory = "1" Then
  Msgbox "No Folder Was Selected"
  continue = 1
Else
  Selection = MsgBox("Compress all subfolders in " & Directory , 1, "Continue?")

  if Selection = 2 then
    continue = 1
  Else
    Set Folder = fso.GetFolder(Directory)
    Set Files = Folder.Files
    Set Folder = Folder.SubFolders
  End IF
End IF

If fso.FileExists(WinRarPath) = False Then
  Msgbox "Path to WinRar is not Valid"
  continue = 1
End IF

if continue <> 1 then

  dim filesys, filetxt
  Const ForReading = 1, ForWriting = 2, ForAppending = 8
  Set filesys = CreateObject("Scripting.FileSystemObject")
  Set filetxt = filesys.OpenTextFile("c:\log2.txt", ForAppending, True)


  For Each SubFolder in Folder

    Dim sDrive, sDir, sFname, sExt
    SplitPath SubFolder, sDrive, sDir, sFname, sExt

    switches = "-ilogc:\log1.txt -IBCK -INUL -ep1 a -r " & """" & Directory & "\" & sFname & ".zip" & """" & " " & """" & Directory & "\" & sFname
    objShell.Run """" & WinRarPath & """" & switches & """"

    filetxt.WriteLine("""" & WinRarPath & """" & switches & """")

  Next
End If

filetxt.Close

If fso.FileExists("c:\log1.txt") = True Then
  objShell.Run "notepad c:\log1.txt"
End If

If fso.FileExists("c:\log2.txt") = True Then
  objShell.Run "notepad c:\log2.txt"
End If


Sub SplitPath(ByVal sPath, ByRef sDrive, ByRef sDir, ByRef sFname, ByRef sExt)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  sDrive = fso.GetDriveName(sPath)
  sDir = Mid(fso.GetParentFolderName(sPath), Len(sDrive)+1) & "\"
  sFname = fso.GetBaseName(sPath)
  sExt = "." & fso.GetExtensionName(sPath)
  Set fso = Nothing
End Sub




function fnShellBrowseForFolderVB()
  dim objShell
  dim ssfDRIVES
  dim objFolder
 
  ssfDRIVES = 17
  set objShell = CreateObject("Shell.Application")
  set objFolder = objShell.BrowseForFolder(0, "Select folder", 0, ssfDRIVES)

  if (not objFolder is nothing) then
    Set objFolder = objFolder.Self
    objFolderPath = objFolder.Path
  end if

  if objFolderPath <> "" then
     fnShellBrowseForFolderVB = objFolderPath
  Else
     fnShellBrowseForFolderVB = 1
  End IF
end function

Here is a version that uses 7-zip instead to compress the files.

You can download 7-zip free from here-
http://www.7-zip.org/







zipPath = "C:\Program Files\7-Zip\7z.exe"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Directory = fnShellBrowseForFolderVB()

If Directory = "1" Then
  Msgbox "No Folder Was Selected"
  continue = 1
Else
  Selection = MsgBox("Compress all subfolders in " & Directory , 1, "Continue?")

  if Selection = 2 then
    continue = 1
  Else
    Set Folder = fso.GetFolder(Directory)
    Set Files = Folder.Files
    Set Folder = Folder.SubFolders
  End IF
End IF

If fso.FileExists(zipPath) = False Then
  Msgbox "Path to Z-Zip is not Valid"
  continue = 1
End IF

if continue <> 1 then

  For Each SubFolder in Folder

    Dim sDrive, sDir, sFname, sExt
    SplitPath SubFolder, sDrive, sDir, sFname, sExt

    switches = " a -tzip """ & sFname & ".zip "" " & """" & SubFolder & "\*"""

    objShell.Run """" & zipPath & """" & switches & """"

  Next
End If

Sub SplitPath(ByVal sPath, ByRef sDrive, ByRef sDir, ByRef sFname, ByRef sExt)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  sDrive = fso.GetDriveName(sPath)
  sDir = Mid(fso.GetParentFolderName(sPath), Len(sDrive)+1) & "\"
  sFname = fso.GetBaseName(sPath)
  sExt = "." & fso.GetExtensionName(sPath)
  Set fso = Nothing
End Sub




function fnShellBrowseForFolderVB()
  dim objShell
  dim ssfDRIVES
  dim objFolder
 
  ssfDRIVES = 17
  set objShell = CreateObject("Shell.Application")
  set objFolder = objShell.BrowseForFolder(0, "Select folder", 0, ssfDRIVES)

  if (not objFolder is nothing) then
    Set objFolder = objFolder.Self
    objFolderPath = objFolder.Path
  end if

  if objFolderPath <> "" then
     fnShellBrowseForFolderVB = objFolderPath
  Else
     fnShellBrowseForFolderVB = 1
  End IF
end function

acsell your log1.txt file says 2 types of errors - "Cannot open C:\Rar$SF00.500" and "No files to add". Notes - my WinRar's Temp Directory is C:\; the disk C:\ is not full and I have all permissions to read/write on it (I am the administrator); there is no empty directory to compress (all have files and subfolders); my WinRar works perfectly when I make all the other actions. Is this information enough ?

is there a log2.txt on your C: drive?

Just incase you missed it (since we posted at a similar time)  I have posted an alternative script using 7-zip above.

acsell - there is a log2.txt but it says nothing about errors. log1.txt says 2 types of errors - "Cannot open C:\Rar$SF00.500" and "No files to add". Now I tried the script using 7-zip but it was also bad - it opens many command-line/prompt windows (like when we run cmd.exe - the "ugly" black MS-DOS text interface), but such command-line/prompt windows quickly close themselves, and not even one archive is made (zero archives made). What the hell ! This seems a spell against us :( Thanks for being patient and persistent !

Hello asgarcymed, Sorry about this.
The black boxes are meant to appear but they should list all of the files that have been compressed before they dissapear. I have made a slight modification to the 7-zip script for you to try. If this doesn't work, could you post a couple lines from the log2.txt just so I can see that the syntax for winrar is being done correctly. I'll try and see if there is another way of doing it.









zipPath = "C:\Program Files\7-Zip\7z.exe"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Directory = fnShellBrowseForFolderVB()

If Directory = "1" Then
  Msgbox "No Folder Was Selected"
  continue = 1
Else
  Selection = MsgBox("Compress all subfolders in " & Directory , 1, "Continue?")

  if Selection = 2 then
    continue = 1
  Else
    Set Folder = fso.GetFolder(Directory)
    Set Files = Folder.Files
    Set Folder = Folder.SubFolders
  End IF
End IF

If fso.FileExists(zipPath) = False Then
  Msgbox "Path to Z-Zip is not Valid"
  continue = 1
End IF

if continue <> 1 then

  For Each SubFolder in Folder

    Dim sDrive, sDir, sFname, sExt
    SplitPath SubFolder, sDrive, sDir, sFname, sExt

    switches = " a -tzip """ & Directory & "\" & sFname & ".zip "" " & """" & SubFolder & "\*"""

    objShell.Run """" & zipPath & """" & switches & """"

  Next
End If

Sub SplitPath(ByVal sPath, ByRef sDrive, ByRef sDir, ByRef sFname, ByRef sExt)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  sDrive = fso.GetDriveName(sPath)
  sDir = Mid(fso.GetParentFolderName(sPath), Len(sDrive)+1) & "\"
  sFname = fso.GetBaseName(sPath)
  sExt = "." & fso.GetExtensionName(sPath)
  Set fso = Nothing
End Sub




function fnShellBrowseForFolderVB()
  dim objShell
  dim ssfDRIVES
  dim objFolder
 
  ssfDRIVES = 17
  set objShell = CreateObject("Shell.Application")
  set objFolder = objShell.BrowseForFolder(0, "Select folder", 0, ssfDRIVES)

  if (not objFolder is nothing) then
    Set objFolder = objFolder.Self
    objFolderPath = objFolder.Path
  end if

  if objFolderPath <> "" then
     fnShellBrowseForFolderVB = objFolderPath
  Else
     fnShellBrowseForFolderVB = 1
  End IF
end function

Another one to try-







zipPath = "C:\Program Files\7-Zip\7z.exe"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Directory = fnShellBrowseForFolderVB()

If Directory = "1" Then
  Msgbox "No Folder Was Selected"
  continue = 1
Else
  Selection = MsgBox("Compress all subfolders in " & Directory , 1, "Continue?")

  if Selection = 2 then
    continue = 1
  Else
    Set Folder = fso.GetFolder(Directory)
    Set Files = Folder.Files
    Set Folder = Folder.SubFolders
  End IF
End IF

If fso.FileExists(zipPath) = False Then
  Msgbox "Path to Z-Zip is not Valid"
  continue = 1
End IF

if continue <> 1 then

  For Each SubFolder in Folder

    Dim sDrive, sDir, sFname, sExt
    SplitPath SubFolder, sDrive, sDir, sFname, sExt

    switches = " a -tzip """ & Directory & "\" & sFname & ".zip"" " & """" & SubFolder & "\*"""

    objShell.Run """" & zipPath & """" & switches

  Next
End If

Sub SplitPath(ByVal sPath, ByRef sDrive, ByRef sDir, ByRef sFname, ByRef sExt)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  sDrive = fso.GetDriveName(sPath)
  sDir = Mid(fso.GetParentFolderName(sPath), Len(sDrive)+1) & "\"
  sFname = fso.GetBaseName(sPath)
  sExt = "." & fso.GetExtensionName(sPath)
  Set fso = Nothing
End Sub




function fnShellBrowseForFolderVB()
  dim objShell
  dim ssfDRIVES
  dim objFolder
 
  ssfDRIVES = 17
  set objShell = CreateObject("Shell.Application")
  set objFolder = objShell.BrowseForFolder(0, "Select folder", 0, ssfDRIVES)

  if (not objFolder is nothing) then
    Set objFolder = objFolder.Self
    objFolderPath = objFolder.Path
  end if

  if objFolderPath <> "" then
     fnShellBrowseForFolderVB = objFolderPath
  Else
     fnShellBrowseForFolderVB = 1
  End IF
end function

Here is a simplified version to help narrow down the problem. You have to specify the folder manually though.



Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

'set directory here
Directory = "c:\A\"

'set 7-zip location
zipPath = "C:\Program Files\7-Zip\7z.exe"

Set Folders = fso.GetFolder(Directory)
Set Folder = Folders.SubFolders

For Each SubFolder in Folder
    switches = " a -tzip """ & SubFolder & ".zip"" " & """" & SubFolder & "\*"""
    objShell.Run """" & zipPath & """" & switches
Next

And a shortened version of the WinRAR script-


Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

'set directory here
Directory = "c:\A\"

'set 7-zip location
zipPath = "C:\Program Files\WinRAR\WinRAR.exe"

Set Folders = fso.GetFolder(Directory)
Set Folder = Folders.SubFolders

For Each SubFolder in Folder
    switches = " -IBCK -INUL -ep1 a -r """ & SubFolder & ".zip"" """ & SubFolder & "\*"""
    msgbox switches
    objShell.Run """" & zipPath & """" & switches
Next

acsell - this second version of 7-zip's script produces exactely the same result (equal to the first).
Here is a line of log2.txt using WinRar's script :

"C:\Programas\WinRAR\WinRAR.exe"-ilogc:\log1.txt -IBCK -INUL -ep1 a -r "L:\teste\Focus All CD DVD Burner v2.zip" "L:\teste\Focus All CD DVD Burner v2".

As you see I have the Portuguese version of Windows XP (I am from Portugal), but I have corrected zipPath = "C:\Program Files\..." to zipPath = "C:\Programas\...", so that is OK.

Thanks for that information. Does this work?


Set objShell = CreateObject("WScript.Shell")
objShell.Run "C:\Programas\WinRAR\WinRAR.exe -IBCK -INUL -ep1 a -r " & """L:\teste\Focus All CD DVD Burner v2.zip"" " & " ""L:\teste\Focus All CD DVD Burner v2"""

acsell - when I run this new vbs file :

Set objShell = CreateObject("WScript.Shell")
objShell.Run "C:\Programas\WinRAR\WinRAR.exe -IBCK -INUL -ep1 a -r " & """L:\teste\Focus All CD DVD Burner v2.zip"" " & " ""L:\teste\Focus All CD DVD Burner v2"""


I can not see any result; it seems that I have done nothing

That's odd. I'm starting to run out of ideas : )

Here is an even simpler version. Does it give you any errors? The following zip file should be created -  L:\teste\Focus All CD DVD Burner v2.zip



Set objShell = CreateObject("WScript.Shell")
objShell.Run "C:\Programas\WinRAR\WinRAR.exe a -r " & """L:\teste\Focus All CD DVD Burner v2.zip"" " & " ""L:\teste\Focus All CD DVD Burner v2"""



You could also try-

Set objShell = CreateObject("WScript.Shell")
objShell.Run "C:\Programas\WinRAR\WinRAR.exe a -r " & """c:\Focus All CD DVD Burner v2.zip"" " & " ""L:\teste\Focus All CD DVD Burner v2"""


That should create the zip file on the c drive.

acsell - when I run this 2 vbs files :

Set objShell = CreateObject("WScript.Shell")
objShell.Run "C:\Programas\WinRAR\WinRAR.exe a -r " & """L:\teste\Focus All CD DVD Burner v2.zip"" " & " ""L:\teste\Focus All CD DVD Burner v2"""

and

Set objShell = CreateObject("WScript.Shell")
objShell.Run "C:\Programas\WinRAR\WinRAR.exe a -r " & """c:\Focus All CD DVD Burner v2.zip"" " & " ""L:\teste\Focus All CD DVD Burner v2"""

I get the same problem - WinRar is loaded and appears a WinRar's error message that says "No files to add". Again I say that there is no empty directory to compress (all have files and subfolders), and my WinRar works perfectly when I make all the other actions.

Here, in Portugal, it is now 22h 30m (10h 30m PM) and I must go sleeping. Tomorrow I will continue to post replies. Thank.

I think I know why it isn't working. I'm pretty sure this will work now.



Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

'>>>>    set directory here

Directory = "L:\teste\"

'>>>>    7-Zip location

zipPath = "C:\Programas\7-Zip\7z.exe"

fso.CopyFile zipPath, Directory
WScript.sleep(1000)
NewZipDir = Directory & "7z.exe"

Set Folders = fso.GetFolder(Directory)
Set Folder = Folders.SubFolders

For Each SubFolder in Folder
  SplitPath SubFolder, sDrive, sDir, sFname, sExt
  sFname = Replace(sFname,"\","")
  command = """" & NewZipDir & """ a -tzip """ & sFname & ".zip"" """ &  sFname & """"
  objShell.CurrentDirectory = Directory
  objShell.Run command
Next

Sub SplitPath(ByVal sPath, ByRef sDrive, ByRef sDir, ByRef sFname, ByRef sExt)
  Set fso = CreateObject("Scripting.FileSystemObject")
  sDrive = fso.GetDriveName(sPath)
  sDir = Mid(fso.GetParentFolderName(sPath), Len(sDrive)+1) & "\"
  sFname = fso.GetBaseName(sPath)
  sExt = "." & fso.GetExtensionName(sPath)
  Set fso = Nothing
End Sub

damianiw solution also seems to work. I knew there must be an application to do it somewhere : )

acsell - the last script (using 7-zip) opens many command-line/prompt windows, but such command-line/prompt windows quickly close themselves, and not even one archive is made (zero archives made). The only thing that happens is that 7z.exe file is copied to L:\teste\

damianiw - the PowerArchiver's batch zip creation option is no good because we have to select folders one by one rather than select them all by only one mouse click :(

Just out of interest, does the script run properly if you run it from the same folder as the the one with all of the sub folders in? e.g. if copy you it to and run it from L:\teste\

To acsell and damianiw - now the question is solved ! :) Using PowerArchive and making exactly what acsell said :

- go to Tools>Batch archive creation
- Click "Add Folder"
- Locate the folder that contains all of the sub folders e.g. L:\teste\
- Under Destination folder, select "custom folder" and enter where you want the compressed files to be stored e.g. L:\teste\
- Put a tick next to "Group Files from Same Folder into same archive"
-Click "Run"

That is a perfect solution; no other could be better !

To acsell - my AntiVirus allows .vbs and .js scripts to run (I activated the option "Allow Windows Script Host to Run All Scripts"); and I have the last version of 7-Zip (I downloaded it yesterday from the official site). When I run the the last script (using 7-zip), now located itself inside L:\teste\ folder, the result is exactly the same - it  opens many command-line/prompt windows, but such command-line/prompt windows quickly close themselves, and not even one archive is made (zero archives made). Again, the only thing that happens is that 7z.exe file is copied to L:\teste\. If you want to continue trying to debug the vbs code go ahead and I will be able to send you feedback... Knowledge is very important ! But if you do not want to do that I will not be upset... Do what you think it is better to you.

I must split points between acsell (because he gave me the information I needed to close the question, and was very, very patient and persistent) and damianiw (because he was the first to present the idea - using PowerArchiver).

I want to thank you guys for trying to help me. Thank to all of you, with a special thank you to acsell and damianiw.

I'm glad to hear that solution worked  : )

>>  If you want to continue trying to debug the vbs code go ahead and I will be able to send you feedback...
>>  Knowledge is very important ! But if you do not want to do that I will not be upset... Do what you think it is better to you.

Thanks for the offer but I've completely run out of ideas as to why it didin't work : )
I have learnt quite a bit from writing and debuging it though.



Thanks for the points. : )
Jon