vb script browse and capture file path - vbscript

Hi I am using following vb-script to browse for file and capture its path for further processing.
Dim sStartPath, sStartFile, sFilter, sCaption
sStartPath = "D:\Remote"
sStartFile = sStartPath & "\nul"
sFilter = "All Files (*.*)|*.*|" _
& "VBScript (*.vbs;*.vbc)|*.vbs;*.vbc|" _
& "HTML (*.htm;*.html;*.hta)|*.htm;*.html;*.hta|"
sCaption = "Choose a File:"
Sub BrForFile_onclick
sBFF = Dlg.OpenFileDlg( CStr(sStartFile), , CStr(sFilter), CStr(sCaption))
If not sBFF = "" Then
document.Copy_To_PC.txtfile.value = sBFF
document.Copy_To_PC.OKbuton.value = "Treat file"
End If
ProcessFile sBff.path
End Sub
I can not get path using sBFF.path. What is wrong with this. I have to process .txt, .sql and .xml files using my vbscript.
My ProcessFile sub takes file path and process it. Initially I was hardfeeding file path to the Sub

Related

Is it possible to rename the downloaded attachment from alm? [duplicate]

I am trying to rename a file and was using the below code but it does not seem to work. Can someone please tell me why? What is the correct way to rename a file from VBScript?
FSO.GetFile("MyFile.txt).Name = "Hello.txt"
I am using this thread for reference: Rename files without copying in same folder
You can rename the file using FSO by moving it: MoveFile Method.
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile "A.txt", "B.txt"
I see only one reason your code to not work, missed quote after file name string:
VBScript:
FSO.GetFile("MyFile.txt[missed_quote_here]).Name = "Hello.txt"
Yes you can do that.
Here I am renaming a .exe file to .txt file
rename a file
Dim objFso
Set objFso= CreateObject("Scripting.FileSystemObject")
objFso.MoveFile "D:\testvbs\autorun.exe", "D:\testvbs\autorun.txt"
Rename filename by searching the last character of name. For example,
Original Filename: TestFile.txt_001
Begin Character need to be removed: _
Result: TestFile.txt
Option Explicit
Dim oWSH
Dim vbsInterpreter
Dim arg1 'As String
Dim arg2 'As String
Dim newFilename 'As string
Set oWSH = CreateObject("WScript.Shell")
vbsInterpreter = "cscript.exe"
ForceConsole()
arg1 = WScript.Arguments(0)
arg2 = WScript.Arguments(1)
WScript.StdOut.WriteLine "This is a test script."
Dim result
result = InstrRev(arg1, arg2, -1)
If result > 0 then
newFilename = Mid(arg1, 1, result - 1)
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile arg1, newFilename
WScript.StdOut.WriteLine newFilename
End If
Function ForceConsole()
If InStr(LCase(WScript.FullName), vbsInterpreter) = 0 Then
oWSH.Run vbsInterpreter & " //NoLogo " & Chr(34) & WScript.ScriptFullName & Chr(34)
WScript.Quit
End If
End Function
From what I understand, your context is to download from ALM.
In this case, ALM saves the files under:
C:/Users/user/AppData/Local/Temp/TD_80/ALM_VERSION/random_string/Attach/artefact_type/ID
where :
ALM_VERSION is the version of your alm installation, e.g 12.53.2.0_952
artefact_type is the type of the artefact, e.g : REQ
ID is the ID of the artefact
Herebelow a code sample which connects to an instance of ALM, domain 'DEFAUT', project 'MY_PROJECT', gets all the attachments from a REQ with id 6 and saves them in c:/tmp. It's ruby code, but it's easy to transcribe to VBSctript
require 'win32ole'
require 'fileutils'
# login to ALM and domain/project
alm_server = ENV['CURRRENT_ALM_SERVER']
tdc = WIN32OLE.new('TDApiOle80.TDConnection')
tdc.InitConnectionEx(alm_server)
username, password = ENV['ALM_CREDENTIALS'].split(':')
tdc.Login(username, password)
tdc.Connect('DEFAULT', 'MY_PROJECT')
# get a handle for the Requirements
reqFact = tdc.ReqFactory
# get Requirement with ID=6
req = reqFact.item(6)
# get a handle for the attachment of REQ
att = req.Attachments
# get a handle for the list of attachements
attList = att.NewList("")
thePath= 'c:/tmp'
# for each attachment:
attList.each do |el|
clientPath = nil
# download the attachment to its default location
el.Load true, clientPath
baseName = File.basename(el.FileName)
dirName = File.dirname(el.FileName)
puts "file downloaded as : #{baseName}\n in Folder #{dirName}"
FileUtils.mkdir_p thePath
puts "now moving #{baseName} to #{thePath}"
FileUtils.mv el.FileName, thePath
end
The output:
=> file downloaded as : REQ_6_20191112_143346.png
=> in Folder C:\Users\user\AppData\Local\Temp\TD_80\12.53.2.0_952\e68ab622\Attach\REQ\6
=> now moving REQ_6_20191112_143346.png to c:/tmp
Below code absolutely worked for me to update File extension.
Ex: abc.pdf to abc.txt
Filepath = "Pls mention your Filepath"
Set objFso = CreateObject("Scripting.FileSystemObject")
'' Below line of code is to get the object for Folder where list of files are located
Set objFolder = objFso.GetFolder(Filepath)
'' Below line of code used to get the collection object to hold list of files located in the Filepath.
Set FileCollection = objFolder.Files
For Each file In FileCollection
WScript.Echo "File name ->" + file.Name
''Instr used to Return the position of the first occurrence of "." within the File name
s = InStr(1, file.Name, ".",1)
WScript.Echo s
WScript.Echo "Extn --> " + Mid(file.Name, s, Len(file.Name))
'Left(file.Name,s-1) = Used to fetch the file name without extension
' Move method is used to move the file in the Desitnation folder you mentioned
file.Move(Filepath & Left(file.Name,s-1)&".txt")
Next
Rename File using VB SCript.
Create Folder Source and Archive in D : Drive. [You can choose other drive but make change in code from D:\Source to C:\Source in case you create folder in C: Drive]
Save files in Source folder to be renamed.
Save below code and save it as .vbs e.g ChangeFileName.vbs
Run file and the file will be renamed with existing file name and current date
Option Explicit
Dim fso,sfolder,fs,f1,CFileName,strRename,NewFilename,GFileName,CFolderName,CFolderName1,Dfolder,afolder
Dim myDate
myDate =Date
Function pd(n, totalDigits)
if totalDigits > len(n) then
pd = String(totalDigits-len(n),"0") & n
else
pd = n
end if
End Function
myDate=
Pd(DAY(date()),2) & _
Pd(Month(date()),2) & _
YEAR(Date())
'MsgBox ("Create Folders 'Source' 'Destination ' and 'Archive' in D drive. Save PDF files into Source Folder ")
sfolder="D:\Source\"
'Dfolder="D:\Destination\"
afolder="D:\archive\"
Set fso= CreateObject("Scripting.FileSystemObject")
Set fs= fso.GetFolder(sfolder)
For each f1 in fs.files
CFileName=sfolder & f1.name
CFolderName1=f1.name
CFolderName=Replace(CFolderName1,"." & fso.GetExtensionName(f1.Path),"")
'Msgbox CFileName
'MsgBox CFolderName
'MsgBox myDate
GFileName=fso.GetFileName(sfolder)
'strRename="DA009B_"& CFolderName &"_20032019"
strRename= "DA009B_"& CFolderName &"_"& myDate &""
NewFilename=replace(CFileName,CFolderName,strRename)
'fso.CopyFile CFolderName1 , afolder
fso.MoveFile CFileName , NewFilename
'fso.CopyFile CFolderName, Dfolder
Next
MsgBox "File Renamed Successfully !!! "
Set fso= Nothing
Set fs=Nothing

How do I rename a file using VBScript?

I am trying to rename a file and was using the below code but it does not seem to work. Can someone please tell me why? What is the correct way to rename a file from VBScript?
FSO.GetFile("MyFile.txt).Name = "Hello.txt"
I am using this thread for reference: Rename files without copying in same folder
You can rename the file using FSO by moving it: MoveFile Method.
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile "A.txt", "B.txt"
I see only one reason your code to not work, missed quote after file name string:
VBScript:
FSO.GetFile("MyFile.txt[missed_quote_here]).Name = "Hello.txt"
Yes you can do that.
Here I am renaming a .exe file to .txt file
rename a file
Dim objFso
Set objFso= CreateObject("Scripting.FileSystemObject")
objFso.MoveFile "D:\testvbs\autorun.exe", "D:\testvbs\autorun.txt"
Rename filename by searching the last character of name. For example,
Original Filename: TestFile.txt_001
Begin Character need to be removed: _
Result: TestFile.txt
Option Explicit
Dim oWSH
Dim vbsInterpreter
Dim arg1 'As String
Dim arg2 'As String
Dim newFilename 'As string
Set oWSH = CreateObject("WScript.Shell")
vbsInterpreter = "cscript.exe"
ForceConsole()
arg1 = WScript.Arguments(0)
arg2 = WScript.Arguments(1)
WScript.StdOut.WriteLine "This is a test script."
Dim result
result = InstrRev(arg1, arg2, -1)
If result > 0 then
newFilename = Mid(arg1, 1, result - 1)
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile arg1, newFilename
WScript.StdOut.WriteLine newFilename
End If
Function ForceConsole()
If InStr(LCase(WScript.FullName), vbsInterpreter) = 0 Then
oWSH.Run vbsInterpreter & " //NoLogo " & Chr(34) & WScript.ScriptFullName & Chr(34)
WScript.Quit
End If
End Function
From what I understand, your context is to download from ALM.
In this case, ALM saves the files under:
C:/Users/user/AppData/Local/Temp/TD_80/ALM_VERSION/random_string/Attach/artefact_type/ID
where :
ALM_VERSION is the version of your alm installation, e.g 12.53.2.0_952
artefact_type is the type of the artefact, e.g : REQ
ID is the ID of the artefact
Herebelow a code sample which connects to an instance of ALM, domain 'DEFAUT', project 'MY_PROJECT', gets all the attachments from a REQ with id 6 and saves them in c:/tmp. It's ruby code, but it's easy to transcribe to VBSctript
require 'win32ole'
require 'fileutils'
# login to ALM and domain/project
alm_server = ENV['CURRRENT_ALM_SERVER']
tdc = WIN32OLE.new('TDApiOle80.TDConnection')
tdc.InitConnectionEx(alm_server)
username, password = ENV['ALM_CREDENTIALS'].split(':')
tdc.Login(username, password)
tdc.Connect('DEFAULT', 'MY_PROJECT')
# get a handle for the Requirements
reqFact = tdc.ReqFactory
# get Requirement with ID=6
req = reqFact.item(6)
# get a handle for the attachment of REQ
att = req.Attachments
# get a handle for the list of attachements
attList = att.NewList("")
thePath= 'c:/tmp'
# for each attachment:
attList.each do |el|
clientPath = nil
# download the attachment to its default location
el.Load true, clientPath
baseName = File.basename(el.FileName)
dirName = File.dirname(el.FileName)
puts "file downloaded as : #{baseName}\n in Folder #{dirName}"
FileUtils.mkdir_p thePath
puts "now moving #{baseName} to #{thePath}"
FileUtils.mv el.FileName, thePath
end
The output:
=> file downloaded as : REQ_6_20191112_143346.png
=> in Folder C:\Users\user\AppData\Local\Temp\TD_80\12.53.2.0_952\e68ab622\Attach\REQ\6
=> now moving REQ_6_20191112_143346.png to c:/tmp
Below code absolutely worked for me to update File extension.
Ex: abc.pdf to abc.txt
Filepath = "Pls mention your Filepath"
Set objFso = CreateObject("Scripting.FileSystemObject")
'' Below line of code is to get the object for Folder where list of files are located
Set objFolder = objFso.GetFolder(Filepath)
'' Below line of code used to get the collection object to hold list of files located in the Filepath.
Set FileCollection = objFolder.Files
For Each file In FileCollection
WScript.Echo "File name ->" + file.Name
''Instr used to Return the position of the first occurrence of "." within the File name
s = InStr(1, file.Name, ".",1)
WScript.Echo s
WScript.Echo "Extn --> " + Mid(file.Name, s, Len(file.Name))
'Left(file.Name,s-1) = Used to fetch the file name without extension
' Move method is used to move the file in the Desitnation folder you mentioned
file.Move(Filepath & Left(file.Name,s-1)&".txt")
Next
Rename File using VB SCript.
Create Folder Source and Archive in D : Drive. [You can choose other drive but make change in code from D:\Source to C:\Source in case you create folder in C: Drive]
Save files in Source folder to be renamed.
Save below code and save it as .vbs e.g ChangeFileName.vbs
Run file and the file will be renamed with existing file name and current date
Option Explicit
Dim fso,sfolder,fs,f1,CFileName,strRename,NewFilename,GFileName,CFolderName,CFolderName1,Dfolder,afolder
Dim myDate
myDate =Date
Function pd(n, totalDigits)
if totalDigits > len(n) then
pd = String(totalDigits-len(n),"0") & n
else
pd = n
end if
End Function
myDate=
Pd(DAY(date()),2) & _
Pd(Month(date()),2) & _
YEAR(Date())
'MsgBox ("Create Folders 'Source' 'Destination ' and 'Archive' in D drive. Save PDF files into Source Folder ")
sfolder="D:\Source\"
'Dfolder="D:\Destination\"
afolder="D:\archive\"
Set fso= CreateObject("Scripting.FileSystemObject")
Set fs= fso.GetFolder(sfolder)
For each f1 in fs.files
CFileName=sfolder & f1.name
CFolderName1=f1.name
CFolderName=Replace(CFolderName1,"." & fso.GetExtensionName(f1.Path),"")
'Msgbox CFileName
'MsgBox CFolderName
'MsgBox myDate
GFileName=fso.GetFileName(sfolder)
'strRename="DA009B_"& CFolderName &"_20032019"
strRename= "DA009B_"& CFolderName &"_"& myDate &""
NewFilename=replace(CFileName,CFolderName,strRename)
'fso.CopyFile CFolderName1 , afolder
fso.MoveFile CFileName , NewFilename
'fso.CopyFile CFolderName, Dfolder
Next
MsgBox "File Renamed Successfully !!! "
Set fso= Nothing
Set fs=Nothing

VB Script to replace text by using folder structure

I am very new to VB Script. I am in need of VB Script to replace the specific text
Below is my file directory
E:\TEST\98\6549871\1959893\HTML
E:\TEST\98\6549871\1959793\HTML
E:\TEST\98\6549876\1959863\HTML
E:\TEST\96\6749473\6959895\HTML
E:\TEST\99\2548878\5959893\HTML
etc.,
Where in each HTML sub-folder, test.html and img.html page will contain. In that html pages I want to find the text ="img/ and needs to replace with ="/image/98/6549871/1959893/HTML/img/ where in ="/image/ is common for all files and remaining values are as per folder structure (i.e. 1st level folder name, 2nd level folder name, 3rd level folder name and 4th level folder name)
For every individual file I need to do like above, and taking too much time to do this activity.
Can any body help me on this to replace all ="img/ in a single shot base on the folder directory.
Thanks in advance
Something like this..not tested, but shoudl point you in the right direction
Option Explicit
Dim fileCount
Sub ProcessSubDirectory( ByVal directory)
On Error Resume Next
Dim fso
Dim dir
Dim folder
Dim file
Set fso = CreateObject("Scripting.FileSystemObject")
Set dir = fso.GetFolder(directory)
If Err.Number <> 0 THen
MsgBox "Failed to open dir ( " & directory & " )"
Exit Sub
End If
On Error Goto 0
For Each file in dir.Files
Call HandleFileFix( file.Path )
Next
For Each folder in dir.SubFolders
Call ProcessSubDirectory( folder.Path )
Next
Set fso = Nothing
End Sub
Sub HandleFileFix( ByVal file)
Dim fso
Dim f
Dim fo
Dim contents
DIm path
Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.GetFile( file )
Set f = fso.OpenTextFile( file, 1 )
path = fo.Path
path = Replace( path, fo.Drive, "")
path = Replace( path, fo.Name, "")
path = Replace( path, "\", "/")
If f.AtEndOfStream = false then
contents = f.ReadAll
End If
f.Close
Set f = Nothing
contents = Replace( contents, "='img/", "='" & path & "/img/")
' write file back to disk
Set f = fso.OpenTextFile( file, 2 )
f.Write contents
f.Close
fileCount = fileCount + 1
Set f = Nothing
End Sub
fileCount = 0
Call ProcessSubDirectory( "D:\TEST\" )
MsgBox "done (" & CStr(fileCount) & ")"

What the win cmd to open a particular spreadsheet in Excel?

I know that you can open an Excel file from the win cmd line. But how would you open a particular spreadsheet in that file using win cmd?
Paste the following code into a text editor (NotePad, WordPad, Word
etc)
Save the file with a "vbs" extension, for example
ExcelSheet2.vbs
Change this line strFileName = "c:\temp\testa.xlsx" to your
desired Excel file path
You can then run this from the commandline by entering the path name of your vbs file
The code has error handling in case the filepath is wrong, or a second sheet isn't present.
[Updated: added further error handling to test for the second sheet being hidden]
Const xlVisible = -1
Dim objExcel
Dim objWb
Dim objws
Dim strFileName
strFileName = "c:\temp\test.xlsx"
On Error Resume Next
Set objExcel = CreateObject("excel.application")
Set objWb = objExcel.Workbooks.Open(strFileName)
Set objws = objWb.Sheets(2)
On Error GoTo 0
If Not IsEmpty(objws) Then
If objws.Visible = xlVisible Then
objExcel.Goto objws.Range("a1")
Else
wscript.echo "the 2nd sheet is present but is hidden"
End If
objExcel.Visible = True
Else
objExcel.Quit
Set objExcel = Nothing
If IsEmpty(objWb) Then
wscript.echo strFileName & " not found"
Else
wscript.echo "sheet2 not found"
End If
End If
Alternatively you could open the workbook from the command line and add the below code to the Workbook to activate "Sheet2"
Private Sub Workbook_Open()
ThisWorkbook.Sheets("Sheet2").Activate
End Sub
You will need to make sure the workbook is in a trusted location and security settings allow the macro to run. #brettdj's solution is much superior but this is an alternative.

Can Windows' built-in ZIP compression be scripted?

Is the ZIP compression that is built into Windows XP/Vista/2003/2008 able to be scripted at all? What executable would I have to call from a BAT/CMD file? or is it possible to do it with VBScript?
I realize that this is possible using WinZip, 7-Zip and other external applications, but I'm looking for something that requires no external applications to be installed.
There are VBA methods to zip and unzip using the windows built in compression as well, which should give some insight as to how the system operates. You may be able to build these methods into a scripting language of your choice.
The basic principle is that within windows you can treat a zip file as a directory, and copy into and out of it. So to create a new zip file, you simply make a file with the extension .zip that has the right header for an empty zip file. Then you close it, and tell windows you want to copy files into it as though it were another directory.
Unzipping is easier - just treat it as a directory.
In case the web pages are lost again, here are a few of the relevant code snippets:
ZIP
Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function Split97(sStr As Variant, sdelim As String) As Variant
'Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function
Sub Zip_File_Or_Files()
Dim strDate As String, DefPath As String, sFName As String
Dim oApp As Object, iCtr As Long, I As Integer
Dim FName, vArr, FileNameZip
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"
'Browse to the file(s), use the Ctrl key to select more files
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
MultiSelect:=True, Title:="Select the files you want to zip")
If IsArray(FName) = False Then
'do nothing
Else
'Create empty Zip File
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
I = 0
For iCtr = LBound(FName) To UBound(FName)
vArr = Split97(FName(iCtr), "\")
sFName = vArr(UBound(vArr))
If bIsBookOpen(sFName) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close it and try again: " & FName(iCtr)
Else
'Copy the file to the compressed folder
I = I + 1
oApp.Namespace(FileNameZip).CopyHere FName(iCtr)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = I
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
End If
Next iCtr
MsgBox "You find the zipfile here: " & FileNameZip
End If
End Sub
UNZIP
Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
'Root folder for the new folder.
'You can also use DefPath = "C:\Users\Ron\test\"
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
'Make the normal folder in DefPath
MkDir FileNameFolder
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
'If you want to extract only one file you can use this:
'oApp.Namespace(FileNameFolder).CopyHere _
'oApp.Namespace(Fname).items.Item("test.txt")
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
Yes, this can be scripted with VBScript. For example the following code can create a zip from a directory:
Dim fso, winShell, MyTarget, MySource, file
Set fso = CreateObject("Scripting.FileSystemObject")
Set winShell = createObject("shell.application")
MyTarget = Wscript.Arguments.Item(0)
MySource = Wscript.Arguments.Item(1)
Wscript.Echo "Adding " & MySource & " to " & MyTarget
'create a new clean zip archive
Set file = fso.CreateTextFile(MyTarget, True)
file.write("PK" & chr(5) & chr(6) & string(18,chr(0)))
file.close
winShell.NameSpace(MyTarget).CopyHere winShell.NameSpace(MySource).Items
do until winShell.namespace(MyTarget).items.count = winShell.namespace(MySource).items.count
wscript.sleep 1000
loop
Set winShell = Nothing
Set fso = Nothing
You may also find http://www.naterice.com/blog/template_permalink.asp?id=64 helpful as it includes a full Unzip/Zip implementation in VBScript.
If you do a size check every 500 ms rather than a item count it works better for large files. Win 7 writes the file instantly although it's not finished compressing:
set fso=createobject("scripting.filesystemobject")
Set h=fso.getFile(DestZip)
do
wscript.sleep 500
max = h.size
loop while h.size > max
Works great for huge amounts of log files.
Just for clarity: GZip is not an MS-only algorithm as suggested by Guy Starbuck in his comment from August.
The GZipStream in System.IO.Compression uses the Deflate algorithm, just the same as the zlib library, and many other zip tools. That class is fully interoperable with unix utilities like gzip.
The GZipStream class is not scriptable from the commandline or VBScript, to produce ZIP files, so it alone would not be an answer the original poster's request.
The free DotNetZip library does read and produce zip files, and can be scripted from VBScript or Powershell. It also includes command-line tools to produce and read/extract zip files.
Here's some code for VBScript:
dim filename
filename = "C:\temp\ZipFile-created-from-VBScript.zip"
WScript.echo("Instantiating a ZipFile object...")
dim zip
set zip = CreateObject("Ionic.Zip.ZipFile")
WScript.echo("using AES256 encryption...")
zip.Encryption = 3
WScript.echo("setting the password...")
zip.Password = "Very.Secret.Password!"
WScript.echo("adding a selection of files...")
zip.AddSelectedFiles("*.js")
zip.AddSelectedFiles("*.vbs")
WScript.echo("setting the save name...")
zip.Name = filename
WScript.echo("Saving...")
zip.Save()
WScript.echo("Disposing...")
zip.Dispose()
WScript.echo("Done.")
Here's some code for Powershell:
[System.Reflection.Assembly]::LoadFrom("c:\\dinoch\\bin\\Ionic.Zip.dll");
$directoryToZip = "c:\\temp";
$zipfile = new-object Ionic.Zip.ZipFile;
$e= $zipfile.AddEntry("Readme.txt", "This is a zipfile created from within powershell.")
$e= $zipfile.AddDirectory($directoryToZip, "home")
$zipfile.Save("ZipFiles.ps1.out.zip");
In a .bat or .cmd file, you can use the zipit.exe or unzip.exe tools. Eg:
zipit NewZip.zip -s "This is string content for an entry" Readme.txt src
There are both zip and unzip executables (as well as a boat load of other useful applications) in the UnxUtils package available on SourceForge (http://sourceforge.net/projects/unxutils). Copy them to a location in your PATH, such as 'c:\windows', and you will be able to include them in your scripts.
This is not the perfect solution (or the one you asked for) but a decent work-a-round.
to create a compressed archive you can use the utility MAKECAB.EXE
Here'a my attempt to summarize built-in capabilities windows for compression and uncompression - How can I compress (/ zip ) and uncompress (/ unzip ) files and folders with batch file without using any external tools?
with a few given solutions that should work on almost every windows machine.
As regards to the shell.application and WSH I preferred the jscript
as it allows a hybrid batch/jscript file (with .bat extension) that not require temp files.I've put unzip and zip capabilities in one file plus a few more features.

Resources