I have a batch script that does the following tasks.
1. Create a backup folder
2. Zip specific files (text files in .log format) and move zipped files to backup folder
3. Delete the original files after moving
To accomplish the 2nd task, I'm writing the commands into VBScript file from batch script like below and then executing the VBScript at the end of batch script.
echo Option Explicit >> zipIt.vbs
REM remaining commands
CScript zipIt.vbs
The batch script successfully performs all 3 tasks for a file of size 100 MB.
But fails at VBScript command for file of size 1 GB. Following error is thrown at command prompt
C:\Users\Administrator\Desktop\zipIt.vbs(18, 1) Microsoft VBScript runtime error
: Permission denied
Below is the content of zipIt.vbs Written line numbers here for convenience.
1. Option Explicit
2. Dim FileToZip, Result
3. Dim oShell
4. Dim file
5. Dim oFileSys
6. Dim winShell
7. FileToZip = "C:\Program Files\logs\File_2013-04-29.log"
8. Result = "C:\Program Files\logs\File_2013-04-29.log.zip"
9. Set oShell = CreateObject("WScript.Shell")
10. Set oFileSys = CreateObject("Scripting.FileSystemObject")
11. Set file = oFileSys.CreateTextFile(Result, True)
12. file.Write "PK" & Chr(5) & Chr(6) & String(18, 0)
13. file.Close
14. Set file = nothing
15. set winShell = createObject("shell.application")
16. winShell.namespace(Result).CopyHere FileToZip
17. wScript.Sleep(5000)
18. oFileSys.DeleteFile FileToZip
Getting the same error if VBScript is run alone. Is it because of large file size?
This is most definitely a problem with memory, seeing as applications are capped at a maximum of 2GB, within windows at least, it is most likely an issue of the program trying to access memory that it was not allocated.
Alternative solution
Split large log files in little chunks:
BreakFile = "C:\Users\Administrador\Desktop\Test.txt"
limit = 400000 ' Bytes
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Breakfile, 1)
FiletoSplit = objFSO.GetFileName(BreakFile)
FolderDest = Mid(objFSO.GetAbsolutePathName(BreakFile),1,Len(objFSO.GetAbsolutePathName(BreakFile))-(Len(FiletoSplit)))
FileSplitName = objFSO.GetBaseName(BreakFile)
dtmStart = Now()
Set objFile = objFSO.OpenTextFile(Breakfile, 1)
strContents = objFile.ReadAll
FileNum = 1
fname = FolderDest & FileSplitName & "Split " & FileNum & ".txt"
Set objFile1 = objFSO.OpenTextFile(fname, 2, True)
CountLines = 0
arrLines = Split(strContents, vbCrLf)
HeaderText = arrLines(0)
For i = 0 to ubound(arrlines)
strLine = arrLines(i) & vbCrLf
objFile1.Write strLine
If (Countlines) < limit Then
countlines = countlines + 1
ElseIf Countlines >= limit Then
objFile1.Close
Countlines = 0
FileNum = FileNum + 1
fname = FolderDest & FileSplitName & "Split " & FileNum & ".txt"
Set objFile1 = objFSO.OpenTextFile(fname, 2, True)
objFile1.Write HeaderText & vbCrLf
End If
Next
objFile.Close
dtmEnd = Now()
Then Zip it all together, and when extract the content, use a "Copy /B" batch command like this to join the chunks:
Copy /B "MyLog_Part*" "MyLog_Complete.log"
Related
i am new to VBS scripting and I have done few stuff with Excel VBA before. Now I have a script which renames single files with the pathname of the files (truncated to 4 letter each))see below. It is some script which I modified a bit to fit my purpose. However, I would like to automatize the file rename process and rename all files in a folder and its subfolders in the same way the scipt works for single files. Can anybody help me with this question?
Set Shell = WScript.CreateObject("WScript.Shell")
Set Parameter = WScript.Arguments
For i = 0 To Parameter.Count - 1
Set fso = CreateObject("Scripting.FileSystemObject")
findFolder = fso.GetParentFolderName(Parameter(i))
PathName = fso.GetAbsolutePathName(Parameter(i))
FileExt = fso.GetExtensionName(Parameter(i))
Search = ":"
findFolder2= Right(PathName, Len(PathName) - InStrRev(PathName, Search))
arr = Split(findFolder2, "\")
For j=0 To UBound(arr)-1
arr(j) = ucase(Left(arr(j), 4))
Next
joined = Join(arr, "%")
prefix = right(joined, len(joined)-1)
fso.MoveFile Parameter(i), findFolder + "\" + prefix
next
Hoping that I can get some useful ideas.
Herbie
Walking a tree requires recursion, a function calling itself for each level.
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Dirname = InputBox("Enter Dir name")
ProcessFolder DirName
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
msgbox Thing.Name & " " & Thing.DateLastModified
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
From Help on how to run another file.
Set Shell = WScript.CreateObject("WScript.Shell")
shell.Run(strCommand, [intWindowStyle], [bWaitOnReturn])
So outside the loop,
Set Shell = WScript.CreateObject("WScript.Shell")
And in the loop
shell.Run("wscript Yourscript.vbs thing.name, 1, True)
Also the VBS help file has recently been taken down at MS web site. It is available on my skydrive at https://1drv.ms/f/s!AvqkaKIXzvDieQFjUcKneSZhDjw It's called script56.chm.
I have written a small script to rename a file based on an ID number within. I have never worked with vbs before, so I am still quite unfamiliar with it. I have worked out most of the issues and everything is working correctly up until the MoveFile command at the end. Just for testing purposes, I have the files saved to C:\temp and am trying to moveFile back to C:. Is this not allowed or something?
Here is my code:
Dim objFSO,foldername, folder, objFile, tsfiles, f1, textfile, line, filename, destinationfile
foldername = "C:\Temp"
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set folder = objFSO.GetFolder(foldername)
Set tsfiles = folder.Files
For each f1 in tsfiles
filename = f1.name
textfile = foldername + "\" + filename
If Instr(f1.name, ".TS") <> 0 Then
Set objFile = objFSO.OpenTextFile((textfile), ForReading)
Do Until objFile.AtEndOfStream
objFile.ReadLine
line = objFile.ReadLine
If Instr(line, "RECORDER ID:") <> 0 Then
Dim RID
RID = trim(Mid(line, 15, 15))
destinationfile = foldername + "\" + RID + ".txt"
MsgBox(destinationfile)
objFSO.MoveFile textfile, destinationfile
objFile.close
End If
Loop
End if
Next
You are opening then text file and the you try to move it while it's still open. You'll have to close it prior to moving it.
Also, this ain't specific to vbscript but usually, moving files in the system drive (in your case the C:) requires administrator privileges. I think those rules has been enforced after Windows XP so you may also need to run the script as administrator.
To run as admin you need to right click on it and specifically run as admin.
In your code you are trying to move while it's open. If you close it, thats fie but then it continues to go through the loop and when it tries to access the open file it fails. So you need to close it and break out of the loop. Exit Do will break out of the loop so it doesn't go back and try and evaluate objFile.AtEndOfStream against a closed object.
Dim objFSO,foldername, folder, objFile, tsfiles, f1, textfile, line, filename, destinationfile
foldername = "C:\Temp"
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set folder = objFSO.GetFolder(foldername)
Set tsfiles = folder.Files
For each f1 in tsfiles
filename = f1.name
textfile = foldername + "\" + filename
If Instr(f1.name, ".TS") <> 0 Then
Set objFile = objFSO.OpenTextFile((textfile), ForReading)
Do Until objFile.AtEndOfStream
objFile.ReadLine
line = objFile.ReadLine
If Instr(line, "RECORDER ID:") <> 0 Then
Dim RID
RID = trim(Mid(line, 15, 15))
destinationfile = foldername + "\" + RID + ".txt"
MsgBox(destinationfile)
objFile.close
objFSO.MoveFile textfile, destinationfile
Exit Do
End If
Loop
End if
Next
I have the following script which is gathering all of the information I need but I was wondering how I alter it to print all of the results that are displayed in the windows to a list of some sort? I would like to manipulate this data in excel.
Dim arrHeaders(35)
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("C:directory")
For i = 0 to 34
arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
Next
For Each strFileName in objFolder.Items
For i = 0 to 34
Wscript.Echo i & vbtab & arrHeaders(i) _
& ": " & objFolder.GetDetailsOf(strFileName, i)
Next
Next
Collect the detail information in another array and echo each record as a comma-separated line:
Dim arrData(35)
...
WScript.Echo Join(arrHeaders, ",")
For Each strFileName in objFolder.Items
For i = 0 to 34
arrData(i) = objFolder.GetDetailsOf(strFileName, i)
Next
WScript.Echo Join(arrData, ",")
Next
That way you can redirect the output to a CSV file by running the script with cscript.exe like this:
cscript //NoLogo "C:\path\to\your.vbs" > "C:\path\to\your.csv"
The CSV file can then be opened with Excel.
Another option is to use the FileSystemObject to write the output file from within the script:
Dim arrData(35)
...
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("C:\path\to\your.csv", 2, True)
f.WriteLine Join(arrHeaders, ",")
For Each strFileName in objFolder.Items
For i = 0 to 34
arrData(i) = objFolder.GetDetailsOf(strFileName, i)
Next
f.WriteLine Join(arrData, ",")
Next
f.Close
You don't need to modify the script to send the output to a file. Just open a console, navigate to script location and run the script, redirecting the output from console to a file
myvbscript.vbs > myoutputfile.txt
See:
http://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/redirection.mspx?mfr=true
How could I convert an XLS file to a CSV file on the windows command line.
The machine has Microsoft Office 2000 installed. I'm open to installing OpenOffice if it's not possible using Microsoft Office.
Open Notepad, create a file called XlsToCsv.vbs and paste this in:
if WScript.Arguments.Count < 2 Then
WScript.Echo "Error! Please specify the source path and the destination. Usage: XlsToCsv SourcePath.xls Destination.csv"
Wscript.Quit
End If
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(Wscript.Arguments.Item(0))
oBook.SaveAs WScript.Arguments.Item(1), 6
oBook.Close False
oExcel.Quit
WScript.Echo "Done"
Then from a command line, go to the folder you saved the .vbs file in and run:
XlsToCsv.vbs [sourcexlsFile].xls [destinationcsvfile].csv
This requires Excel to be installed on the machine you are on though.
A slightly modified version of ScottF answer, which does not require absolute file paths:
if WScript.Arguments.Count < 2 Then
WScript.Echo "Please specify the source and the destination files. Usage: ExcelToCsv <xls/xlsx source file> <csv destination file>"
Wscript.Quit
End If
csv_format = 6
Set objFSO = CreateObject("Scripting.FileSystemObject")
src_file = objFSO.GetAbsolutePathName(Wscript.Arguments.Item(0))
dest_file = objFSO.GetAbsolutePathName(WScript.Arguments.Item(1))
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(src_file)
oBook.SaveAs dest_file, csv_format
oBook.Close False
oExcel.Quit
I have renamed the script ExcelToCsv, since this script is not limited to xls at all. xlsx Works just fine, as we could expect.
Tested with Office 2010.
A small expansion on ScottF's groovy VB script: this batch file will loop through the .xlsx files in a directory and dump them into *.csv files:
FOR /f "delims=" %%i IN ('DIR *.xlsx /b') DO ExcelToCSV.vbs "%%i" "%%i.csv"
Note: You may change extension .xlsx to .xls andname of script ExcelToCSV to XlsToCsv
How about with PowerShell?
Code should be looks like this, not tested though
$xlCSV = 6
$Excel = New-Object -Com Excel.Application
$Excel.visible = $False
$Excel.displayalerts=$False
$WorkBook = $Excel.Workbooks.Open("YOUDOC.XLS")
$Workbook.SaveAs("YOURDOC.csv",$xlCSV)
$Excel.quit()
Here is a post explaining how to use it
How Can I Use Windows PowerShell to Automate Microsoft Excel?
I had a need to extract several cvs from different worksheets, so here is a modified version of plang code that allows you to specify the worksheet name.
if WScript.Arguments.Count < 3 Then
WScript.Echo "Please specify the sheet, the source, the destination files. Usage: ExcelToCsv <sheetName> <xls/xlsx source file> <csv destination file>"
Wscript.Quit
End If
csv_format = 6
Set objFSO = CreateObject("Scripting.FileSystemObject")
src_file = objFSO.GetAbsolutePathName(Wscript.Arguments.Item(1))
dest_file = objFSO.GetAbsolutePathName(WScript.Arguments.Item(2))
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(src_file)
oBook.Sheets(WScript.Arguments.Item(0)).Select
oBook.SaveAs dest_file, csv_format
oBook.Close False
oExcel.Quit
Here is a version that will handle multiple files drag and dropped from windows.
Based on the above works by
Christian Lemer
plang
ScottF
Open Notepad, create a file called XlsToCsv.vbs and paste this in:
'* Usage: Drop .xl* files on me to export each sheet as CSV
'* Global Settings and Variables
Dim gSkip
Set args = Wscript.Arguments
For Each sFilename In args
iErr = ExportExcelFileToCSV(sFilename)
' 0 for normal success
' 404 for file not found
' 10 for file skipped (or user abort if script returns 10)
Next
WScript.Quit(0)
Function ExportExcelFileToCSV(sFilename)
'* Settings
Dim oExcel, oFSO, oExcelFile
Set oExcel = CreateObject("Excel.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
iCSV_Format = 6
'* Set Up
sExtension = oFSO.GetExtensionName(sFilename)
if sExtension = "" then
ExportExcelFileToCSV = 404
Exit Function
end if
sTest = Mid(sExtension,1,2) '* first 2 letters of the extension, vb's missing a Like operator
if not (sTest = "xl") then
if (PromptForSkip(sFilename,oExcel)) then
ExportExcelFileToCSV = 10
Exit Function
end if
End If
sAbsoluteSource = oFSO.GetAbsolutePathName(sFilename)
sAbsoluteDestination = Replace(sAbsoluteSource,sExtension,"{sheet}.csv")
'* Do Work
Set oExcelFile = oExcel.Workbooks.Open(sAbsoluteSource)
For Each oSheet in oExcelFile.Sheets
sThisDestination = Replace(sAbsoluteDestination,"{sheet}",oSheet.Name)
oExcelFile.Sheets(oSheet.Name).Select
oExcelFile.SaveAs sThisDestination, iCSV_Format
Next
'* Take Down
oExcelFile.Close False
oExcel.Quit
ExportExcelFileToCSV = 0
Exit Function
End Function
Function PromptForSkip(sFilename,oExcel)
if not (VarType(gSkip) = vbEmpty) then
PromptForSkip = gSkip
Exit Function
end if
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
sPrompt = vbCRLF & _
"A filename was received that doesn't appear to be an Excel Document." & vbCRLF & _
"Do you want to skip this and all other unrecognized files? (Will only prompt this once)" & vbCRLF & _
"" & vbCRLF & _
"Yes - Will skip all further files that don't have a .xl* extension" & vbCRLF & _
"No - Will pass the file to excel regardless of extension" & vbCRLF & _
"Cancel - Abort any further conversions and exit this script" & vbCRLF & _
"" & vbCRLF & _
"The unrecognized file was:" & vbCRLF & _
sFilename & vbCRLF & _
"" & vbCRLF & _
"The path returned by the system was:" & vbCRLF & _
oFSO.GetAbsolutePathName(sFilename) & vbCRLF
sTitle = "Unrecognized File Type Encountered"
sResponse = MsgBox (sPrompt,vbYesNoCancel,sTitle)
Select Case sResponse
Case vbYes
gSkip = True
Case vbNo
gSkip = False
Case vbCancel
oExcel.Quit
WScript.Quit(10) '* 10 Is the error code I use to indicate there was a user abort (1 because wasn't successful, + 0 because the user chose to exit)
End Select
PromptForSkip = gSkip
Exit Function
End Function
You can do it with Alacon - command-line utility for Alasql database. It works with Node.js, so you need to install Node.js and then Alasql package.
To convert Excel file to CVS (ot TSV) you can enter:
> node alacon "SELECT * INTO CSV('mydata.csv', {headers:true}) FROM XLS('mydata.xls', {headers:true})"
By default Alasql converts data from "Sheet1", but you can change it with parameters:
{headers:false, sheetid: 'Sheet2', range: 'A1:C100'}
Alacon supports other type of conversions (CSV, TSV, TXT, XLSX, XLS) and SQL language constructions (see User Manual for examples).
Why not write your own?
I see from your profile you have at least some C#/.NET experience. I'd create a Windows console application and use a free Excel reader to read in your Excel file(s). I've used Excel Data Reader available from CodePlex without any problem (one nice thing: this reader doesn't require Excel to be installed). You can call your console application from the command line.
If you find yourself stuck post here and I'm sure you'll get help.
:: For UTF-8 works for Microsoft Office 2016 and higher!
Try this code:
if WScript.Arguments.Count < 2 Then
WScript.Echo "Please specify the source and the destination files. Usage: ExcelToCsv <xls/xlsx source file> <csv destination file>"
Wscript.Quit
End If
csv_format = 62
Set objFSO = CreateObject("Scripting.FileSystemObject")
src_file = objFSO.GetAbsolutePathName(Wscript.Arguments.Item(0))
dest_file = objFSO.GetAbsolutePathName(WScript.Arguments.Item(1))
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(src_file)
oBook.SaveAs dest_file, csv_format
oBook.Close False
oExcel.Quit
There's an Excel OLEDB data provider built into Windows; you can use this to 'query' the Excel sheet via ADO.NET and write the results to a CSV file. There's a small amount of coding required, but you shouldn't need to install anything on the machine.
Building on what Jon of All Trades has provided, the following (~n) removed the pesky double extension issue:
FOR /f "delims=" %%i IN ('DIR *.xlsx /b') DO ExcelToCSV.vbs "%%i" "%%~ni.csv"
Create a TXT file on your desktop named "xls2csv.vbs" and paste the code:
Dim vExcel
Dim vCSV
Set vExcel = CreateObject("Excel.Application")
Set vCSV = vExcel.Workbooks.Open(Wscript.Arguments.Item(0))
vCSV.SaveAs WScript.Arguments.Item(0) & ".csv", 6
vCSV.Close False
vExcel.Quit
Drag a XLS file to it (like "test.xls"). It will create a converted CSV file named "test.xls.csv". Then, rename it to "test.csv". Done.
I tried ScottF VB solution and got it to work. However I wanted to convert a multi-tab(workbook) excel file into a single .csv file.
This did not work, only one tab(the one that is highlighted when I open it via excel) got copied.
Is any one aware of a script that can convert a multi-tab excel file into a single .csv file?
Scott F's answer is the best I have found on the internet. I did add on to his code to meet my needs. I added:
On Error Resume Next <- To account for a missing xls files in my batch processing at the top.
oBook.Application.Columns("A:J").NumberFormat = "#" <- Before the SaveAs line to make sure my data is saved formatted as text to keep excel from deleting leading zero's and eliminating commas in number strings in my data i.e. (1,200 to 1200). The column range should be adjusted to meet your neeeds (A:J).
I also removed the Echo "done" to make it non interactive.
I then added the script into a cmd batch file for processing automated data on an hourly basis via a task.
All of these answers helped me construct the following script which will automatically convert XLS* files to CSV and vice versa, by dropping one or more files on the script (or via command line). Apologies for the janky formatting.
' https://stackoverflow.com/questions/1858195/convert-xls-to-csv-on-command-line
' https://gist.github.com/tonyerskine/77250575b166bec997f33a679a0dfbe4
' https://stackoverflow.com/a/36804963/1037948
'* Global Settings and Variables
Set args = Wscript.Arguments
For Each sFilename In args
iErr = ConvertExcelFormat(sFilename)
' 0 for normal success
' 404 for file not found
' 10 for file skipped (or user abort if script returns 10)
Next
WScript.Quit(0)
Function ConvertExcelFormat(srcFile)
if IsEmpty(srcFile) OR srcFile = "" Then
WScript.Echo "Error! Please specify at least one source path. Usage: " & WScript.ScriptName & " SourcePath.xls*|csv"
ConvertExcelFormat = -1
Exit Function
'Wscript.Quit
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
srcExt = objFSO.GetExtensionName(srcFile)
' the 6 is the constant for 'CSV' format, 51 is for 'xlsx'
' https://msdn.microsoft.com/en-us/vba/excel-vba/articles/xlfileformat-enumeration-excel
' https://www.rondebruin.nl/mac/mac020.htm
Dim outputFormat, srcDest
If LCase(Mid(srcExt, 1, 2)) = "xl" Then
outputFormat = 6
srcDest = "csv"
Else
outputFormat = 51
srcDest = "xlsx"
End If
'srcFile = objFSO.GetAbsolutePathName(Wscript.Arguments.Item(0))
srcFile = objFSO.GetAbsolutePathName(srcFile)
destFile = Replace(srcFile, srcExt, srcDest)
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(srcFile)
' preserve formatting? https://stackoverflow.com/a/8658845/1037948
'oBook.Application.Columns("A:J").NumberFormat = "#"
oBook.SaveAs destFile, outputFormat
oBook.Close False
oExcel.Quit
WScript.Echo "Conversion complete of '" & srcFile & "' to '" & objFSO.GetFileName(destFile) & "'"
End Function
For anyone wondering how to get your LOCAL delimiter to show up in the csv files instead of the comma/tab this is how you do it. This was soo challenging to find and I am amazed no one ran into it before 2022?
if WScript.Arguments.Count < 2 Then
WScript.Echo "Please specify the source and the destination files. Usage: ExcelToCsv <xls/xlsx source file> <csv destination file>"
Wscript.Quit
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
src_file = objFSO.GetAbsolutePathName(Wscript.Arguments.Item(0))
dest_file = objFSO.GetAbsolutePathName(WScript.Arguments.Item(1))
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(src_file)
local = true
csv_format = 6
oBook.SaveAs dest_file, csv_format, 0, 0, 0, 0, 0, 0, 0, 0, 0, local
oBook.Close False
oExcel.Quit
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