Converting ZIP files to 7Z archive file using VBScript and 7-Zip

Option Explicit

'-----------------
' CONSTANTS START
'-----------------
'[These effectively are the settings for the application.]

'Full path to the 7Zip command line executable
Const COMMAND_LINE_7ZIP_PATH = "C:\Program Files\7-Zip\7z.exe"

'Temporary folder in which to carry out the intermediate work
Const WORKING_FOLDER = "C:\temp\zip-2-7zip_dir\"

'An extension added to the file name to produce an output folder
Const OUTPUT_FOLDER_EXTENSION = "-out"

'Name of the file used as the input in the working directory
Const INPUT_ZIP = "input.zip"

'Name of the file produced as the output in the working directory
Const OUTPUT_7Z = "output.7z"

'Run DOS commands as ...
'Const WIN_MODE =   'Console window hidden entirely
Const WIN_MODE =    'Console window minimised - so you can restore it and view progress when building larger archives

'Clear down the working directory when finished
Const CLEANUP = TRUE

'------------------
' CONSTANTS FINISH
'------------------


'-----------------------
' GLOBAL VARIABLE START
'-----------------------
Dim g_strFilename, g_strInputFile, g_strOutputFile
Dim g_intCounter, g_colArgs
Dim g_strMessage
'------------------------
' GLOBAL VARIABLE FINISH
'------------------------


'--------------------
' MAIN ROUTINE START
'--------------------
'Get the command line arguments for the script
Set g_colArgs = Wscript.Arguments
If g_colArgs.Count > 0 Then 'Each argument should be a ZIP file. '(Process each argument as though it is) For g_intCounter = 0 to g_colArgs.Count - 1 g_strFilename = Wscript.Arguments(g_intCounter) g_strMessage = g_strMessage & ProcessArgument(g_intCounter) Next 'Display an output message g_strMessage = "The following operations were undertaken:" & g_strMessage MsgBox g_strMessage, vbInformation, "Archive Conversion Complete"
Else 'If there's not even one argument/file to process then exit Msgbox "Please pass a file to this script", 48,"No File Provided" WScript.Quit
End If
'---------------------
' MAIN ROUTINE FINISH
'---------------------


'-----------------
' FUNCTIONS START
'-----------------
'Process an argument - i.e. a ZIP file
Function ProcessArgument(p_intParameter) 'If we have a ZIP file, process it If CheckFile(g_strFilename) then 'Clear the working directory ClearWorkingDirectory
 'Copy the zip file to the local working directory 'This way if we're reaching a limit on Dropbox or something we won't blow it g_strInputFile = CopyInputFile(g_strFilename)
 'Extract content of input file ExtractFromZIP(g_strInputFile)
 'Compress extracted files to new archive AddTo7Z GetExtractedOutputFolder(g_strInputFile), GetExtractedOutputArchivePath
 'Copy the zip file to the local working directory 'This way if we're reaching a limit on Dropbox or something we won't blow it g_strOutputFile = CopyOutputFile(GetExtractedOutputArchivePath, g_strFilename)
 'Clear the working directory If CLEANUP then ClearWorkingDirectory 'Add success details to output message queue ProcessArgument = ProcessArgument & vbCrLf & "Creation Complete on Archive (" & p_intParameter & ") = " & g_strOutputFile Else 'Add failure details to output message queue ProcessArgument = ProcessArgument & vbCrLf & "Failed to Process (" & p_intParameter & ") = " & g_strFilename End If
End Function


'Check an input file exsists and is a ZIP file
Function CheckFile(p_strFilePath) Dim objFSO 'Initialise Set objFSO = CreateObject("Scripting.FileSystemObject") CheckFile = FALSE 'Check the file exists and is a zip file If UCase(Right(p_strFilePath,4)) = ".ZIP" then If objFSO.FileExists(p_strFilePath) then CheckFile = TRUE End If End If
End Function


'Copy the ZIP file to the working directory
Function CopyInputFile(p_g_strFilename) Dim objFSO 'Initialise Set objFSO = CreateObject("Scripting.FileSystemObject") 'Copy ZIP file to working directory CopyInputFile = WORKING_FOLDER & INPUT_ZIP objFSO.CopyFile p_g_strFilename, CopyInputFile
End Function


'Copy the 7z file to the directory the input file came from
Function CopyOutputFile(p_str7ZFilePath, p_strOriginalFilePath) Dim objFSO, objFile 'Initialise Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.GetFile(p_strOriginalFilePath) 'Copy ZIP file to working directory CopyOutputFile = objFSO.GetParentFolderName(p_strOriginalFilePath) & "\" & objFSO.GetBaseName(p_strOriginalFilePath) & ".7z" objFSO.CopyFile p_str7ZFilePath, CopyOutputFile, True
End Function


'Extract the files and folders in the ZIP to the working directory output folder
Function ExtractFromZIP(p_g_strFilename) 'Extract files and folders from the ZIP file to the output directory in the working directory Execute7ZIPCommand "x """ & p_g_strFilename & """ -r -o""" & GetExtractedOutputFolder(p_g_strFilename) & """" ExtractFromZIP = TRUE
End Function


'Add the files from the output folder to a new 7z archive file in the working directory
Function AddTo7Z(p_strFolderPath, p_strOutputFilePath) 'Add files and folders to a new 7z archive file Dim strCommand 'Archive files to a 7z file format strCommand = "a -t7z" 'Archive to this file path strCommand = strCommand & " """ & p_strOutputFilePath & """" 'Archive the content of this folder and sub folders strCommand = strCommand & " -r """ & p_strFolderPath & "\*""" 'Use ultra compression strCommand = strCommand & " -mx9"
 'Remove any previous files Execute7ZIPCommand strCommand 'Return the path to the archive file AddTo7Z = p_strOutputFilePath
End Function


'Get the path to the output folder in the working directory
Function GetExtractedOutputFolder(p_g_strInputFile) 'Add the output folder extension test to the end of the input file path to give the output file path GetExtractedOutputFolder = p_g_strInputFile & OUTPUT_FOLDER_EXTENSION
End Function


'Get the path to the 7z archive file in the working directory
Function GetExtractedOutputArchivePath() 'Return the path of the output archive GetExtractedOutputArchivePath = WORKING_FOLDER & OUTPUT_7Z
End Function


'Get the name of the input file from its path
Function GetInputFileName(p_g_strFilename) 'Get the input file name from the input file path Dim objFSO, objFile Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.GetFile(p_g_strFilename) GetInputFileName = objFile.Name
End Function
'------------------
' FUNCTIONS FINISH
'------------------


'--------------------
' SUB-ROUTINES START
'--------------------
'Execute 7z from the command line
Sub Execute7ZIPCommand(p_strCommand) 'Execute a 7Zip command Dim objShell 'Initialise Set objShell = CreateObject("WScript.Shell") 'Execute command objShell.Run """" & COMMAND_LINE_7ZIP_PATH & """ " & p_strCommand, WIN_MODE, TRUE
End Sub


'Make the working directory (empty)
Sub ClearWorkingDirectory() 'Remove all files from the working folder Dim objShell Set objShell = CreateObject("WScript.Shell") 'Remove then create the working directory - to blitz any files in there and ensure our working directory exists objShell.Run "%comspec% /c rmdir /s /q """ & WORKING_FOLDER & """", WIN_MODE, TRUE objShell.Run "%comspec% /c mkdir """ & WORKING_FOLDER & """", WIN_MODE, TRUE
End Sub
'---------------------
' SUB-ROUTINES FINISH
'---------------------