A previous team where I work created a vbs script that can automatically start a restore of a Macrium Image File located on inserted optical media. The problem is that the Macrium Image File is now too big for one disc, and now we have it split onto 2 separate discs, so now the vbs script doesn't function the way it should.
When Automatic Restore is launched, it should detect disc 1, which ends in 00.00.mrimg and know that it is part of a multi-disc install, at which point it asks for the next disc, ending in 00-01.mrimg.
I know this probably makes no sense, especially if anyone reading is not familiar with Macrium. But I will do my best to answer any questions.
I would normally plug away and try to figure it out myself, but i'm not very familiar with VBS and the problem is pretty time sensitive. Any help I can get will be much appreciated.
Opened AutoRestore.vbs script to see if I could fix the issue, but I don't know enough about vbs to fix it.
'AutoRestore.vbs
Dim fso, d, dc, s, n , Root, u, racine, folder, folderName, restoreString, foundFile, cdDrive
Dim wipe
Dim objShell
Set objShell = WScript.CreateObject("WScript.shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
foundFile = false
restoreString = "00-00.mrimg"
For Each d in dc
Root = d.Driveletter & ":"
racine = d.Driveletter & ":\"
u= Detect(Root)
if (( u="CD-ROM") ) then
cdDrive = cdDrive & racine & " "
if (d.isReady) then
folderName = racine & "IAS\"
Set folder = fso.GetFolder(folderName)
end if
end if
Next
If IsNull(folder) or IsEmpty(folder) Then
MsgBox "Could not locate IAS folder containing restore image." & vbCrLf & "The following optical disk drives were searched: " & cdDrive & vbCrLf & "Please verify the media is the drive or use manual restore.", 48, "Folder Not Found"
Else
For each file in folder.Files
If instr(1,file.Name, restoreString, vbTextCompare) > 0 Then
return = objShell.run("""%ProgramFiles%\macrium\diskrestore.exe""" & folderName & file.Name & " -r -g -u --targetnum 0 --reboot --eject",1,false)
foundFile = true
Exit For
End If
Next
if (foundFile = false) Then
MsgBox "Cannot locate .mrimg file in " & folderName & "." & vbCrLf & "Please use manual restore.", 48, "File Not Found"
End If
End If
Function Detect(DrivePath)
Dim fso, d, s, t
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(DrivePath)))
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
Detect = t
End Function
Expected Results: Run AutoRestore.vbs, the script sees the 00-00.mrimg file in IAS folder of the optical media, then prompts to insert the optical media containing the 00-01.mrimg file.
Actual Results: Run AutoRestore.vbs, then Macrium states "Backup set is not complete. At least one file may be missing."
You could first copy all the mrimg files to a temporary folder on the machine's hard drive. Once you have them all, you can then run Disk Restore with that folder instead of the CD-ROM drive.
Most of your existing code would work. After the For Each d in dc loop, you know the drive where the discs are being inserted. You could add another loop:
Dim tempFolder
Set tempFolder = fso.GetFolder("C:\AutoRestore\")
Do While MsgBox("Please insert disc and click OK. When all discs have been inserted, click Cancel", vbOKCancel, "Auto Restore") = vbOK
For Each file In folder.Files
If InStr(1, file.Name, ".mrimg") > 0 Then
' Copy file to Temp folder
fso.CopyFile file.Path, tempFolder.Path & "\", True
End If
Next
Loop
After this, you should have all the mrimg files in the tempFolder location. I am not familiar with the parameters the Marcium command expects but this is where you would specify the new folder:
objShell.run("""%ProgramFiles%\macrium\diskrestore.exe""" & tempFolder.Path & "\" & file.Name & " -r -g -u --targetnum 0 --reboot --eject",1,false)
Related
I have a question regarding how I should go about fixing an error that I am seeing when running my script. I am pretty sure it has to do with the way in which I am using the %COMPUTERNAME% environment variable.
What my script does is it zips up some files locally, then copies them using robocopy to a mounted or shared drive, then checks to see if the file sizes are the same, and if they are then it deletes the files on the original computer. If any step in the process produces an error it exits the script.
Now the script works perfectly fine if I do not add in the "%COMPUTERNAME%" to the final destination path. (Where the zipped files will eventually be) I need the zipped files to be placed into their own folders with the name of the host from which it originated, because this script will be run on many different machines all going to the same location.
So basically it needs to look something like this:
E:\LocalHostName\TestZip.zip
Now the script will build the folder just fine when the zipped files are being copied over, the problem occurs once the file size check starts. I am getting the error of "File not found" for the line "FileToBeCompared2". I understand why the error is being produced, because it is not recogizing the %COMPUTERNAME% environment variable, but I do not know how to go about addressing this issue.
I am also going to try to add in some functionality where if an error occurs a text file with something like "An error occured during the script" is produced in the output folder.
Thank you for all your help in advance. The script is found below:
'-------------------------------------------------------------------------------------------
'This script is used to zip files locally, copy them to a new location, verify that the
'files were copied correctly, and then delete the files from the original source.
'In it's current state it is being used as a means to zip event files and move them
'to a central location.
'Run with administrator priveleges.
'-----------------------------------------------------------------------------------------------------
Option Explicit
Dim sDirectoryPath, sLocalDestinationPath, sFinalDestinationPath, sOutputFilename, Shell, sFileExt, sFilePrefix
Set Shell = WScript.CreateObject("WScript.Shell")
'Specify Directory Path where files to be zipped are located
'Specify local destination for zipped files
'Specify final destination path for zippped files
'Specify file extension name to look for
'Specify prefix of filename to look for
sDirectoryPath = "C:\Testscripts\"
sLocalDestinationPath = "C:\ScriptOutput\"
sFinalDestinationPath = "E:\CopyTestFolder\" & sOutputFilename & "\"
sFileExt = ".evtx"
sFilePrefix = "Archive*"
sOutputFilename = shell.ExpandEnvironmentStrings("%COMPUTERNAME%") 'Environment variables needed for grabbing hostname
Dim ZipCommand, RobocopyCommand, RunCommand, filesys, filetext
Dim d : d = Date()
Dim dateStr : dateStr = Year(d) & "-" & Right("00" & Month(d), 2) & "-" & Right("00" & Day(d), 2) 'Date String
Dim t : t = Time()
Dim timeStr: timeStr = Hour(t) & "-" & Right("00" & Minute(t), 2) & "-" & Right("00" & Second(t), 2) 'Time String
Dim FullFileName
FullFileName = sOutputFilename & "-" & dateStr & "-" & timeStr & ".zip "
'Following command runs 7-zip and grabs the files to be zipped from your set sDirectoryPath, zips them into set sLocalDestinationPath
'and names the file with the localhost name and date/time
ZipCommand = """C:\Program Files\7-zip\7z.exe"" a " & sLocalDestinationPath & FullFileName & sDirectoryPath & sFilePrefix & sFileExt
RunCommand = Shell.Run(ZipCommand,0,true)
if err.Number <> 0 then
WScript.Echo "An error has occurred during the zip process, re-run Script." WScript.Quit
end if
Wscript.Sleep 2000
'The following command creates a folder named after the host computer where the files are being copied from
Dim newfolder, newfolderpath, filesys2
newfolderpath = "E:\CopyTestFolder\" & sOutputFilename & "\"
set filesys2 = CreateObject("Scripting.FileSystemObject")
If Not filesys2.FolderExists(newfolderpath) Then
Set newfolder = filesys2.CreateFolder(newfolderpath)
End If
'Following command runs Robocopy from command line, moves files from your set sLocalDestinationPath to your set sFinalDestinationPath
WScript.Echo "Robocopy.exe " & sLocalDestinationPath & " " & sFinalDestinationPath
RobocopyCommand = "Robocopy.exe " & sLocalDestinationPath & " " & sFinalDestinationPath
RunCommand = Shell.Run(RobocopyCommand,0,true)
if err.Number <> 0 then
WScript.Echo "An error has occured copying the files, re-run Script."
WScript.Quit
end if
Dim fso, FileToBeCompared1, FileToBeCompared2
Set fso = CreateObject("Scripting.FileSystemObject")
'Setting the Local file to be compared
Set FileToBeCompared1 = fso.GetFile(sLocalDestinationPath & FullFileName)
WScript.echo sFinalDestinationPath & FullFileName
'Setting the file copied to final destination to be compared
Set FileToBeCompared2 = fso.GetFile(sFinalDestinationPath & FullFileName)
If FileToBeCompared1.size = FileToBeCompared2.size then
fso.DeleteFile("C:\Testscripts\Archive*.evtx") 'This will be the path where events are being Archived to. (Non restricted path)
fso.DeleteFolder("C:\ScriptOutput") 'This deletes the archive folder that 7-zip builds each time this script is run
else
WScript.Echo "File sizes do not match, File was not fully copied, Re run script."
WScript.Quit
end if
Because fso.GetFile() will not automatically expand %COMPUTERNAME%, modify sFinalDestinationPath to use sOutputFilename like this:
sOutputFilename = shell.ExpandEnvironmentStrings("%COMPUTERNAME%")
sFinalDestinationPath = "E:\CopyTestFolder\" & sOutputFilename & "\"
I am having a problem with my script not actually producing a zip file. When I test the script with the paths set to something like this:
C:\Users\Bob\Desktop\Folder1\Folder2
with the test log files in folder 1 being deleted if older than 7 days, and being zipped and moved to folder 2, it will run perfectly fine. It will produce the zipped file with all of the log files in it and have the proper naming set.
So I know that at least the logic of the script works for that.
My problem is that I need this script to go through the security logs on a machine and delete any older than 7 days, and then zip up any that are left and be sent to a mounted shared drive. When I change the path to something like:
C:\Windows\System32\Config (where the logs are located)
it will still delete any log files older than 7 days, but it does not produce a zip file with any that are left. It just does nothing even though the script produces no errors. I've been trying to figure this out with no luck going over my code. If anyone could take a look over what I've had and let me know where I've gone astray that would be extremely helpful.
Thank you in advance, the script is found below.
'READ FIRST
'------------------------------------------------------------------------------------------
'Lines 14-53 delete any log files older than 7 days. Changing the value in "iDaysOld =" will change the time frame in which files are kept or deleted.
'If files do not need to be deleted this part of the script can be taken out and the Archive/Move ability will still be intact
'Lines 57-102 contain the ability to Zip your log files and send them to a new folder. The zipped file is named after the localhost and a date/timestamp is appended to the file name.
'------------------------------------------------------------------------------------------
Option Explicit
Dim oFSO, oFolder, sDirectoryPath
Dim oFileCollection, oFile, sDir
Dim iDaysOld
' Specify Directory Path From Where You want to clear the old files
sDirectoryPath = "C:\Windows\System32\config"
' Specify Number of Days Old File to Delete
iDaysOld = 7
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sDirectoryPath)
Set oFileCollection = oFolder.Files
For each oFile in oFileCollection
'Specify the Extension of file that you want to delete
'and the number with Number of character in the file extension
If LCase(oFSO.GetExtensionName(oFile.Name)) = "log" Then
If oFile.DateLastModified < (Date() - iDaysOld) Then
oFile.Delete(True)
End If
End If
Next
Set oFSO = Nothing
Set oFolder = Nothing
Set oFileCollection = Nothing
Set oFile = Nothing
WScript.Echo "Press to start zipping log files."
Dim objFile, objPath, objFolder, Command, PathLogs, RetVal
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objShell: Set objShell = CreateObject("WScript.Shell")
Dim d : d = Date()
Dim dateStr : dateStr = Year(d) & "-" & Right("00" & Month(d), 2) & "-" & Right("00" & Day(d), 2)
Dim t : t = Time()
Dim timeStr: timeStr = Hour(t) & "-" & Right("00" & Minute(t), 2) & "-" & Right("00" & Second(t), 2)
'Path where logs are located
PathLogs = "C:\Windows\System32\config"
'Loop through the logs and zip
Set objPath = objFSO.GetFolder(PathLogs)
For Each objFile In objPath.Files
If (LCase(objFSO.GetExtensionName(objFile)) = "log") Then
' zip files
Command = """C:\Program Files\7-zip\7z.exe"" a " & PathLogs & "%computername%" & "-" & dateStr & "-" & timeStr & ".zip " & PathLogs & objFile.Name
RetVal = objShell.Run(Command,0,true)
End If
Next
WScript.Echo "Zip Successful."
WScript.Echo "Now Moving Zipped Files into Archived Folder"
'move files
Set objFSO = CreateObject("Scripting.FilesystemObject")
objFSO.MoveFile "C:\Windows\System32\config\*.zip" , "C:\Testscripts\testfolder\Archived"
WScript.Echo "Move Successful."
I'd probably try echoing out the 7zip command line, checking that it looks right and running it manually from the same location as the script runs from. It might look wrong when you see it or 7zip might give you a message to indicate what's going on.
I am writing a script to determine the combined size of all instances of a particular subfolder within the profile folder of each user who has logged onto a Windows 2003 server, e.g. all users' desktop folders or all users' local settings folders.
Option Explicit
Dim colSubfolders, intCount, intCombinedSize, objFolder2, objFSO1, objFSO2, objUserFolder, strOutput, objSearchFolder, objSubfolder, strSearchFolder, strSubfolderPath
intCount = 0
intCombinedSize = 0
strSearchFolder = "C:\Documents and Settings\"
Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objSearchFolder = objFSO1.GetFolder(strSearchFolder)
Set colSubfolders = objSearchFolder.SubFolders
For Each objUserFolder in colSubfolders
strSubfolderPath = objUserFolder.Path & "\Desktop\"
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
intCount = intCount + 1
intCombinedSize = intCombinedSize + objSubfolder.Size
Next
MsgBox "Combined size of " & CStr(intCount) & " folders: " & CStr(intCombinedSize / 1048576) & " MB"
This code throws a 'Path not found' error (Code 800A004C) at line 15:
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
If I print out strSubfolderPath, however, I find that all the strings returned are valid directory paths, so I don't understand why I'm getting this error.
I've tried with and without the trailing backslash at the end of the path and I've tried with 8.3 style paths to remove spaces but to no effect.
When I run your code I get the same error.
Upon further inspection, on my computer there is a folder named C:\Documents and Settings\machinename, where machinename is the name of my computer. This folder only contains one subfolder named ASPNet.
I'm guessing you have something similar.
To minimize multiple-backslash confusion, use the FileSystemObject methods consistently instead of relying on string concatenation:
strSubfolderPath = objFSO1.BuildPath(objUserFolder.Path,"Desktop")
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
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.