-1

Can anyone make a vbs code that will accept two inputs, first one is the file extension and the second one is the zip filename. The program zips the files with the given extension and puts them in a zipped file with the given input.

sample input:

Enter file type: txt

Enter File name: compress

the vbs will compress all txt files in the folder to compress.zip

note: I am not learning vbs; I have no background whatsoever. Our prof gave us this problem after introducing vbs to us for like 5 mins and he expects us to submit within three days. So please understand my situation.

sync2018
  • 1
  • 2
  • VBScript can only zip an entire folder. You'd have to move them to a folder first. See my answer here on how to loop through files in a folder. http://stackoverflow.com/questions/38448894/how-to-make-replace-function-loops-for-all-the-files-in-the-same-folder-same-di/38449812#38449812 –  Jul 25 '16 at 02:09
  • I'll try your suggestion. and thanks! – sync2018 Jul 25 '16 at 03:21
  • And see here to do the zipping. http://stackoverflow.com/questions/27975000/using-vbscript-to-examine-properties-of-files-within-a-zip-file –  Jul 25 '16 at 04:36
  • VBScript is perfectly capable of [adding files to a zip file](http://stackoverflow.com/q/19302634/1630171). – Ansgar Wiechers Jul 25 '16 at 10:45

1 Answers1

0

@sync2018: Kindly find the working code below as per your requirement and fine tune it if there is a need for any further modification. Kindly let me know if any further help is needed

Note: This is a working code and unwanted variable or operations might be present

WorkingDir = "Add the path of the directory where the files are present should be zipped" for eg.,"C:\Users\U465205\Desktop\alpa_code\"
zipfile = "Give the path where the zip file should be saved with the file name as well ends with zip extension" for eg.,"C:\Users\U465205\Desktop\alpa_code\mulla.zip"      
Extension = ".csv"
Dim fso, myFolder, fileColl, aFile, FileName, SaveName
Dim objExcel, objWorkbook
Set fso = CreateObject("Scripting.FilesystemObject")
savedir=WorkingDir&"New Folder"
If Not fso.FolderExists(savedir&"\") Then
  fso.CreateFolder savedir&"\"
End If
Set myFolder = fso.GetFolder(WorkingDir)
Set fileColl = myFolder.Files
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.DisplayAlerts = False
For Each aFile In fileColl
ext = Right(aFile.Name,Len(Extension)) 
If UCase(ext) = UCase(extension) Then
fso.CopyFile aFile , savedir &"\"
End If
Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.OpenTextFile(zipfile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
Set ShellApp = CreateObject("Shell.Application")
Set zip = ShellApp.NameSpace(zipfile)
zip.CopyHere savedir
WScript.Sleep 10000
Set objWorkbook = Nothing
Set objExcel = Nothing
Set myFolder = Nothing
Set fileColl = Nothing
Set fso = Nothing
set objFolder = nothing
set objShell = nothing
Set ts = nothing
mulla
  • 143
  • 1
  • 11
  • Please do not grace zero-effort questions with an answer. That kind of question is not appreciated here, and neither is encouraging that kind of behavior. – Ansgar Wiechers Jul 25 '16 at 12:31
  • @AnsgarWiechers: Sorry as i am new to the forum thought of giving the answer and gradually getting to know the rules. – mulla Jul 25 '16 at 12:36