How do I rename a file using VBScript? - 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

Related

Cant move VBScript to another directory, it says "File not found"

Set objShell = CreateObject("Wscript.Shell")
strFile ="Lafarrel.vbs"
dim fso, fullPath
set fso = CreateObject("Scripting.FileSystemObject")
fullPath = fso.GetAbsolutePathName(strFile)
Wscript.Echo fullPath
Wscript.Sleep 1000
dim SourceLocation
dim DestinationLocation
dim FileName
SourceLocation = fullPath
DestinationLocation = """C:\Users\%username%\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup\"""
FileName = "Lafarrel.vbs"
fso.MoveFile SourceLocation & "" & FileName, DestinationLocation & ""
Error starts at line 14
Maybe because the last line is incorrect?
Explain what I want VBScript to do:
I want this VBScript to find itself and then change to a different directory
Use Option Explicit, for everyones' sanity.
Wscript.Sleep 1000 is unnecessary.
This line has problems: DestinationLocation = """C:\Users\%username%\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup\"""
This string-literal contains excessive double-quotes (VBScript uses double-double-quotes to escape individual double-quote chars, but strings containing only paths and filenames should not have internal delimiting quotes.
Also, %username% won't be expanded by FileSystemObject.MoveFile.
You will need to use WshShell.ExpandEnvironmentStrings first.
Also, C:\Users\%username%\AppData\Roaming\... is a poor choice of environment-variable'd-path as the Users directory might not be on C:\, and it might not even be named "Users".
Instead, you should use %APPDATA%.
obj prefixes are ugly and unnecessary.
Dim SourceLocation is redundant as it's an alias of fullPath. Ditto Dim FileName.
GetAbsolutePathName does not verify that the file actually exists: you'll get a runtime error if "Lafarrel.vbs" does not exist in the expected location when the script runs - so expect this situation and add an If guard.
So your code should look like this:
Option Explicit
Dim shell
Set shell = CreateObject( "WScript.Shell" ) ' aka WshShell
Dim fso
Set fso = CreateObject( "Scripting.FileSystemObject" )
Dim lafarrelVbsPath
lafarrelVbsPath = fso.GetAbsolutePathName( "Lafarrel.vbs" )
If fso.FileExists( lafarrelVbsPath ) Then
Dim destinationPath
destinationPath = "%APPDATA%\Microsoft\Windows\Start Menu\Programs\Startup\"
destinationPath = shell.ExpandEnvironmentStrings( destinationPath )
Wscript.Echo "Moving """ & lafarrelVbsPath & """ to """ & destinationPath & """..."
' When `destinationPath` ends with a slash, then "Lafarrel.vbs" won't be renamed (phew).
fso.MoveFile lafarrelVbsPath, destinationPath
Else
Wscript.Echo "Error: File not found: """ & lafarrelVbsPath & """."
End If
WScript.ScriptFullName returns the script path and filename in full.
This sample demonstrates a couple of things including a simple way to isolate the script folder (not really needed for your use case though).
If you save this exact script into your local %temp% folder, and create a folder '%temp%\temp two' (space in there) you can just run it.
Also you MUST use ExpandEnvironmentStrings method to use env vars in a string
strFileName = WScript.Scriptname
strCurrDir = Replace(WScript.ScriptFullName, WScript.Scriptname, "")
Set wshShell = CreateObject("WScript.Shell")
strDestination = wshShell.ExpandEnvironmentStrings("%temp%\temp two\") ' note the space, but no need to double-up quotes. You MUST use ExpandEnvironmentStrings method to use env vars in a string
Wscript.Echo "I am '" & strFileName & "' and I am in '" & strCurrDir & "'"
WScript.Echo "My full path and name in one is: " & WScript.ScriptFullName
' so for moving the file, no need to separate the path and filename, as 'WScript.ScriptFullName' contains all of it (dest file must NOT exist)
' no need to double-up quotes for destination path, as this is not batch and will treat the whole string as path including spaces
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile WScript.ScriptFullName, strDestination
WScript.Echo "I've now been moved to: " & strDestination

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

VBS zipping script

I found (apparently working for everybody) script which only needs to be modified (paths):
Sub NewZip(pathToZipFile)
'WScript.Echo "Newing up a zip file (" & pathToZipFile & ") "
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim file
Set file = fso.CreateTextFile(pathToZipFile)
file.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
file.Close
Set fso = Nothing
Set file = Nothing
WScript.Sleep 500
End Sub
Sub CreateZip(pathToZipFile, dirToZip)
'WScript.Echo "Creating zip (" & pathToZipFile & ") from (" & dirToZip & ")"
Dim fso
Set fso= Wscript.CreateObject("Scripting.FileSystemObject")
pathToZipFile = fso.GetAbsolutePathName(pathToZipFile)
dirToZip = fso.GetAbsolutePathName(dirToZip)
If fso.FileExists(pathToZipFile) Then
'WScript.Echo "That zip file already exists - deleting it."
fso.DeleteFile pathToZipFile
End If
If Not fso.FolderExists(dirToZip) Then
'WScript.Echo "The directory to zip does not exist."
Exit Sub
End If
NewZip pathToZipFile
dim sa
set sa = CreateObject("Shell.Application")
Dim zip
Set zip = sa.NameSpace(pathToZipFile)
'WScript.Echo "opening dir (" & dirToZip & ")"
Dim d
Set d = sa.NameSpace(dirToZip)
' Look at http://msdn.microsoft.com/en-us/library/bb787866(VS.85).aspx
' for more information about the CopyHere function.
zip.CopyHere d.items, 4
Do Until d.Items.Count <= zip.Items.Count
Wscript.Sleep(200)
Loop
End Sub
Can anybody give example how this script should look like with
real paths? I'm trying but it's not working for me.
This script consists solely of two subroutines and thus will never execute anything.
Add the following line to the bottom of the file and it should work (given that the code in the subs is sound, I have not tested):
CreateZip "c:\output\test.zip" "c:\input\"
This will do the following, in order:
Check to see if the output file exists. If it does, it will delete it.
Check to see if the input folder exists, if it does not, the script will exit.
Call the NewZip sub which just creates an "empty" .zip file.
Copy files to the zip file.
Pause for a while, probably to ensure you don't try to access the ZIP before it's done copying.
The contents of the input folder will now be in the zip file in the output folder.

Vbscript and imagemagick error resize

I trying to rezise each subfolders first jpg and put it to new subfolder
Dim strFolderPath,objFSO
strDirectory= "D:\images\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFolder, objSubFolder,folderCur
Set objFolder = objFSO.GetFolder(strDirectory)
Dim imageMagick
Set imageMagick = CreateObject("ImageMagickObject.MagickImage.1")
If objFolder.SubFolders.Count > 0 Then
For Each objSubFolder in objFolder.SubFolders
'Now check if the folder contains any files.
If objSubFolder.Files.Count > 0 Then
folderCur = objSubFolder & "\_small320\"
For each JpgFile in objSubFolder.Files
WScript.Echo "Checking Folder: " & folderCur & "\" & JpgFile.name & vbcrlf & " File: " & JpgFile
if not objFSO.folderexists(folderCur) then objFSO.createfolder folderCur
'imageMagick.Exec("convert " & JpgFile & " -resize 320x210 " & JpgFile.name)
imageMagick.Convert JpgFile, "-resize", "320x210", folderCur & "\preview.jpg"
exit for
next
End If
Next
End If
But I get error on imageMagick.Convert JpgFile, "-resize", "320x210", folderCur & "\preview.jpg"
What is wrong with syntax?
also get this error
But all dlls exist in folder
Not tested (no ImageMagick at hand), but probably
imageMagick.Convert JpgFile.Path, "-resize", "320x210", folderCur & "preview.jpg"
Included full path to the file and removed an additional backslash in the output file (that was included in the folder name).
EDITED Now tested and working. This code processes subfolders of the folder where the script is placed.
Option Explicit
Const OUTPUT_FOLDER_NAME = "_small320"
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim strScriptFolder
strScriptFolder = fso.GetFile( WScript.ScriptFullName ).ParentFolder.Path
Dim rootFolder
Set rootFolder = fso.GetFolder( strScriptFolder )
Dim imageMagick
Set imageMagick = WScript.CreateObject("ImageMagickObject.MagickImage.1")
Dim inputFolder, inputFile, strOutputFolder
For Each inputFolder In rootFolder.SubFolders
If inputFolder.Name <> OUTPUT_FOLDER_NAME Then
strOutputFolder = fso.BuildPath(inputFolder.Path, OUTPUT_FOLDER_NAME)
If Not fso.FolderExists(strOutputFolder) Then
fso.CreateFolder strOutputFolder
End If
For Each inputFile In inputFolder.Files
Select Case LCase(fso.GetExtensionName(inputFile.Path))
Case "jpg", "jpeg", "png"
WScript.Echo "[ convert ] " & inputFile.Path
imageMagick.Convert inputFile.Path, _
"-resize", _
"320x210", _
fso.BuildPath(strOutputFolder, inputFile.Name)
Case Else
WScript.Echo "[ skip ] " & inputFile.Path
End Select
Next
End If
Next
The original error in question (Unsupported argument type) was generated when as argument a File object was passed, instead of a string with the file path.
The Unable to load module is an ImageMagick error, not a programming error. Maybe the path variable is wrong and the modules can not be found or it is a install error. The previous code has been tested (and works) with a fresh ImageMagick-6.9.1-6-Q16-x64-dll.exe install.

Extract files from ZIP file with VBScript

When extracting files from a ZIP file I was using the following.
Sub Unzip(strFile)
' This routine unzips a file. NOTE: The files are extracted to a folder '
' in the same location using the name of the file minus the extension. '
' EX. C:\Test.zip will be extracted to C:\Test '
'strFile (String) = Full path and filename of the file to be unzipped. '
Dim arrFile
arrFile = Split(strFile, ".")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(arrFile(0) & "\ ")
pathToZipFile= arrFile(0) & ".zip"
extractTo= arrFile(0) & "\ "
set objShell = CreateObject("Shell.Application")
set filesInzip=objShell.NameSpace(pathToZipFile).items
objShell.NameSpace(extractTo).CopyHere(filesInzip)
fso.DeleteFile pathToZipFile, True
Set fso = Nothing
Set objShell = Nothing
End Sub 'Unzip
This was working, but now I get a "The File Exists" Error.
What is the reason for this? Are there any alternatives?
All above solutions are accurate, but they are not definitive.
If you are trying to extract a zipped file into a temporary folder, a folder that displays "Temporary Folder For YOURFILE.zip" will immediately be created (in C:\Documents and Settings\USERNAME\Local Settings\Temp) for EACH FILE contained within your ZIP file, which you are trying to extract.
That's right, if you have 50 files, it will create 50 folders within your temp directory.
But if you have 200 files, it will stop at 99 and crash stating - The File Exists.
..
Apparently, this does not occur on Windows 7 with the contributions I view above. But regardless, we can still have checks. Alright, so this is how you fix it:
'========================
'Sub: UnzipFiles
'Language: vbscript
'Usage: UnzipFiles("C:\dir", "extract.zip")
'Definition: UnzipFiles([Directory where zip is located & where files will be extracted], [zip file name])
'========================
Sub UnzipFiles(folder, file)
Dim sa, filesInzip, zfile, fso, i : i = 1
Set sa = CreateObject("Shell.Application")
Set filesInzip=sa.NameSpace(folder&file).items
For Each zfile In filesInzip
If Not fso.FileExists(folder & zfile) Then
sa.NameSpace(folder).CopyHere(zfile), &H100
i = i + 1
End If
If i = 99 Then
zCleanup(file, i)
i = 1
End If
Next
If i > 1 Then
zCleanup(file, i)
End If
fso.DeleteFile(folder&file)
End Sub
'========================
'Sub: zCleanup
'Language: vbscript
'Usage: zCleanup("filename.zip", 4)
'Definition: zCleanup([Filename of Zip previously extracted], [Number of files within zip container])
'========================
Sub zCleanUp(file, count)
'Clean up
Dim i, fso
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 1 To count
If fso.FolderExists(fso.GetSpecialFolder(2) & "\Temporary Directory " & i & " for " & file) = True Then
text = fso.DeleteFolder(fso.GetSpecialFolder(2) & "\Temporary Directory " & i & " for " & file, True)
Else
Exit For
End If
Next
End Sub
And that's it, copy and paste those two functions into your VBScript hosted program and you should be good to go, on Windows XP & Windows 7.
Thanks!
You can use DotNetZip from VBScript.
To unpack an existing zipfile, overwriting any files that may exist:
WScript.echo("Instantiating a ZipFile object...")
Dim zip
Set zip = CreateObject("Ionic.Zip.ZipFile")
WScript.echo("Initialize (Read)...")
zip.Initialize("C:\Temp\ZipFile-created-from-VBScript.zip")
WScript.echo("setting the password for extraction...")
zip.Password = "This is the Password."
' set the default action for extracting an existing file
' 0 = throw exception
' 1 = overwrite silently
' 2 = don't overwrite (silently)
' 3 = invoke the ExtractProgress event
zip.ExtractExistingFile = 1
WScript.echo("extracting all files...")
Call zip.ExtractAll("extract")
WScript.echo("Disposing...")
zip.Dispose()
WScript.echo("Done.")
To create a new zipfile:
dim filename
filename = "C:\temp\ZipFile-created-from-VBScript.zip"
WScript.echo("Instantiating a ZipFile object...")
dim zip2
set zip2 = CreateObject("Ionic.Zip.ZipFile")
WScript.echo("using AES256 encryption...")
zip2.Encryption = 3
WScript.echo("setting the password...")
zip2.Password = "This is the Password."
WScript.echo("adding a selection of files...")
zip2.AddSelectedFiles("*.js")
zip2.AddSelectedFiles("*.vbs")
WScript.echo("setting the save name...")
zip2.Name = filename
WScript.echo("Saving...")
zip2.Save()
WScript.echo("Disposing...")
zip2.Dispose()
WScript.echo("Done.")
There's answers above which are perfectly correct, but I thought I'd wrap everything up into a full solution that I'm using:
strZipFile = "test.zip" 'name of zip file
outFolder = "." 'destination folder of unzipped files (must exist)
'If using full paths rather than relative to the script, comment the next line
pwd = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Set objShell = CreateObject( "Shell.Application" )
Set objSource = objShell.NameSpace(pwd+strZipFile).Items()
Set objTarget = objShell.NameSpace(pwd+outFolder)
intOptions = 256
objTarget.CopyHere objSource, intOptions
'Clean up
Set WshShell = CreateObject("Wscript.Shell")
tempfolder = WshShell.ExpandEnvironmentStrings("%temp%")
Set fso = CreateObject("Scripting.FileSystemObject")
Call fso.DeleteFolder(tempfolder + "\Temporary Directory 1 for " + strZipFile, True )
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23022290.html
Check your temp directory. If you have 99 folders associated with this unzipping process, try deleting them.
I added the following code to the beginning of my unzip procedure to delete these directories before I unzip:
For i = 1 To 99
If aqFileSystem.Exists(GetAppPath("Local Settings", "") & "\Temp\Temporary Directory " & i & " for DialogState.zip") = True Then
result = aqFileSystem.ChangeAttributes(GetAppPath("Local Settings", "") & "\Temp\Temporary Directory " & i & " for DialogState.zip", 1 OR 2, aqFileSystem.fattrFree)
Call DelFolder(GetAppPath("Local Settings", "") & "\Temp\Temporary Directory " & i & " for DialogState.zip")
Else
Exit For
End If
Next

Resources