[Micke]

Hi!

Originally Posted by TBGBe

P.P.S. Just thought - should the output path/filename to add be in quotes ??

That's correct. I have made some more tests and the problem appears when you have spaces in the path and/or in the filename. That's my mistake , because when I tested the script I didn't have any spaces in the path or in the filename resulting in that everything looked ok.

Here's the updated script with support for spaces in path or filename.

'*******************************************************************
'* PACOMP.vbs
'* @author: Micke
'* @hist 2010-02-26	CREATED:Script for compress multiple file types
'* @hist 2010-03-01 BUGFIX:	Space in path or filename resulted in
'*							no archive was created.
'*
'* Script for compress multiple file types
'*
'* Usage: cscript PACOMP.vbs ArchiveName.extension DrivePath
'* Example1: cscript PACOMP.vbs C:\Temp\MyArchive.zip D:
'* Example2: cscript PACOMP.vbs C:\Temp\MyArchive.zip D:\Temp
'*
'*******************************************************************
Option Explicit

'Variables
Dim FSO, objDir, aList, FileExtension, ArchiveName, DrivePath
Dim aFile, aItem, strCompressionString, WshShell

'Constants (Change path to your own enviroment)
Const PACOMP = "C:\Programs\PACL\PACOMP.exe"

'Check number of arguments
If WScript.Arguments.Count <> 2 Then
	WScript.Echo "Usage: cscript PACOMP.vbs ArchiveName.extension DrivePath"
	WScript.Echo "Example 1: cscript PACOMP.vbs C:\Temp\MyArchive.zip D:"
	WScript.Echo "Example 2: cscript PACOMP.vbs C:\Temp\MyArchive.zip D:\Temp"
	WScript.Quit
End If

'Create the FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")

'Create the ShellObject
Set WshShell = CreateObject("WScript.Shell")

'Get data from the Arguments
ArchiveName = WScript.Arguments.Item(0)
DrivePath = WScript.Arguments.Item(1)

'Get the Folders for the DrivePath
Set objDir = FSO.GetFolder(DrivePath)

'Create a Array with Fileextensions for the archive, change to your enviroment
aList = Array("png", "jpg", "avi")

'Search through the folders
SearchFolders(objDir)

'Sub for Searching recursive in Folders
Sub SearchFolders(pstrCurrentPath)
	
	For Each aFile In pstrCurrentPath.Files
		
		For Each FileExtension In aList
			If FileExtension = LCase(Right(CStr(aFile.Name), 3)) Then
				AddFileToArchive aFile.Path
			End If
		Next
		
	Next
	
	For Each aItem In pstrCurrentPath.SubFolders
	   SearchFolders(aItem)
	Next

End Sub

Sub AddFileToArchive(pstrFileName)
	
	'Create the string with parameters for PACOMP
	strCompressionString = PACOMP & " -a -P " & Chr(34) & ArchiveName & Chr(34) & " " & Chr(34) & pstrFileName & Chr(34)
	WScript.Echo strCompressionString
	WshShell.Run strCompressionString, 0, True
	
End Sub

The updated script can be downloaded here: PACOMP_Script_Updated.zip

Please let me know the result after you have tested the updated script.

Kind Regards
Micke