[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 11933
  • Last Modified:

Compressing Files via VBScript

Hello,

I have come across the need to compress some SQL backups as they are made. As such, I needed to create a script that will find the appropriate files, zip them & then delete the original file.

I found the following which seemed to help:
http://groups.google.com/group/microsoft.public.scripting.vbscript/browse_thread/thread/036c926787e64221

I had a completed script, calling the function below, which seemed to be working perfectly. Until, that is, I swapped the test .bak files with something a little bigger in size (from a few bytes to approx 6MB). Now I get the following error:

Error: Object required: 'shl.namespace(...)'
Code: 800A01A8

If I put a msgbox just before the do..loop, i can see the compression dialog and if I wait for this to finish before pressing ok, then no error.

As  such, I need to find a different way to test that the compression is complete. This is where I have now come up against a brick wall.

Is anyone able to suggest an alternative method for checking that this has completed before letting the code move on?

For your information, both strSource & strTarget are provided as filenames with full paths. strTarget being the zip file.

Any help would be greatly appreciated.
Function ZipFile(strSource,strTarget)
	
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	
	'write zip file header 
	set file = fso.opentextfile(strTarget,ForWriting,true) 
	file.write "PK" & chr(5) & chr(6) & string(18,chr(0)) 
	file.close 
 
	'copy source file to zip file
	set shl = CreateObject("Shell.Application")
	shl.namespace(strTarget).copyhere(strSource)
	do until shl.namespace(strTarget).items.count = 1
  		wscript.sleep 100
	loop
	
	set shl = nothing
	
End Function

Open in new window

0
SHardy
Asked:
SHardy
  • 8
  • 2
3 Solutions
 
Krys_KCommented:
HI There

would a popup box work for you?
You can set the time in seconds for it to popup.

Set wshShell = CreateObject("Wscript.Shell")
 wshShell.popup "Message", 5    'seconds

Regards
Krystian
0
 
SHardyAuthor Commented:
I think I have sussed it. You were definitely along the right lines though.

The sleep, at 100 milliseconds, was not enough. Having increased this to a second seems to have fixed the problem.

Presumably with a bigger file it takes a little longer to finalise the copy, despite it already telling the OS that there is a file in the zip folder.

I should have realised this earlier. How many other problems are resolved simply by extending a sleep command? :)

Thanks,
Simon
0
 
SHardyAuthor Commented:
Oh. Spoke too soon.

Seemed to work on the 1st group of files I tested in against. However, I am getting the same error again now, after having run it a few times. I haven even increased the sleep to 3 seconds and then to 5 seconds, but with out any luck.

I am a bit confused why it worked 1st time, but then started to fail on the same files???
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
SHardyAuthor Commented:
This is purely guesswork, but when adding a file into a zip folder, is it given some meaningless name until the compression is completed? Is it possible to look in the zip file/folder and check the name of the item/file compared against strSource? If possible, would this be a better way to check for completion?
0
 
SHardyAuthor Commented:
Sorry, I jumped the gun a bit at closing this off. Could you possibly re-nstate it as open? Thanks.
0
 
Krys_KCommented:
Hi there

Sorry, was away from computer a while.  Is it possible to post the whole code then i can run it to see what is happening for you. Are you using a 3rd party zip tool or...?

Regards
Krystian
0
 
SHardyAuthor Commented:
Hi,

I am not using a 3rd party ziptool. As this is to run on one of our servers, it is preferred to use tools that are available natively. Full code is below. However, I "think" (again) that I "may" have found the issue...

I tried manually creating a zip/compressed folder & copying the largest backup file into there. I then received a message saying that the resulting zip folder would be too big. A quick search told me that the maxcimum size is 2GB. Presumably this limit relates to the final zip file size? The backup file currently stands at approx 28GB. Based upon the compression rate achieved on the ather backup files, this would probably be compressed to about 4GB.

So, after all this it looks like it won't be possible through the standard Windows compression tool. So I am after an alternative. This would preferably be free, but commercial would obviously be considered. It MUST be usable via command line and VBScript. There must be no size limit. Or at least a reasonably large size limit (source file of 30GB+). I would NOT want to split the archive into multiple files. For managability, I would want single file archives. Any suggestions?

Thanks
dim fso, vPath, oFolder, vFullPath, oSubFolder, vFile, vSource, vTarget
 
vPath = "F:\Backup\"
 
set fso = CreateObject("Scripting.FileSystemObject")
 
set oFolder = fso.getfolder(vPath)
for each SubFolder in oFolder.SubFolders
	if SubFolder.Name <> "master" and SubFolder.Name <> "model" and SubFolder.Name <> "msdb" then
		vFullPath = vPath + SubFolder.Name + "\"
		set oSubFolder = fso.getfolder(vFullPath)
		set oFiles = oSubFolder.Files
		for each oFile in oFiles
			if datevalue(oFile.DateLastModified) = datevalue(Date) and right(oFile.Name,3) = "bak" then
				vSource = vFullPath + oFile.Name
				VTarget = replace(vSource,".bak",".zip")
				ZipFile vSource,vTarget
			end if
		next
	end if
next
 
set oFiles = nothing
set oSubFolder = nothing
set oFolder = nothing
set fso = nothing
 
WScript.Quit
 
 
Function ZipFile(strSource,strTarget)
	
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	
	'write zip file header 
	set file = fso.opentextfile(strTarget,ForWriting,true) 
	file.write "PK" & chr(5) & chr(6) & string(18,chr(0)) 
	file.close 
 
	'copy source file to zip file
	set shl = CreateObject("Shell.Application")
	shl.namespace(strTarget).copyhere(strSource)
	do until shl.namespace(strTarget).items.count = 1
  		wscript.sleep 1000
	loop
	
	set shl = nothing
	
End Function

Open in new window

0
 
bucfanjeffCommented:
I have written some programs for zipping "My Documents" folders for my users as a backup utility using the native compression built in to Windows. However, I had to move to a 3rd party because if the users compressed file was greater than 4GB, Windows thinks the file is corrupt. You can't get around this without using a 3rd party to implement in to your code. Currently I'm using http://www.icsharpcode.net/OpenSource/SD/Download/. The hard part is find VB examples for it. I have come a long way though. Hope this helps.
0
 
SHardyAuthor Commented:
Hi,

Thanks for the link. I will take a look at that.

I am currently carrying out tests with 7Zip (http://www.7-zip.org/). This is an open source compression tool with command line option. In fact, it is possible to use without installing by using a standalone exe for command line zipping. However, I think (if all my testing goes ok) I would still have to install it, otherwise it just makes a job of un-compressing if needed.

I will upate this thread when I have reached any conclusions.
0
 
SHardyAuthor Commented:
Sorry for the delay in getting back to this thread. I now have a working & stable solution in place.

It was not possible to complete this using the built-in Windows compression, so I had to use a 3rd part app. The one I went for was the open source 7-Zip (link in previous post). This can be used either by a standalone command line executable (no installation required) or by using the installed client. I opted for the latter, as it just makes life easier if I need to unzip one of the large backup files.

An added benefit of using this 3rd party compression tool is that I no longer need to use shell & the sleep command. I can run the compression direct from the script, and it does not move on until the process is finished.

Having tested & implemented this solution, it has now also been picked up by someone else to use on one of their servers too. This was possible with very few changes required. So, hopefully, the full script posted below will prove helpful to others too.

FYI: I am calling this script from the maintenance plan on a SQL Server 2005 instance. The maintenance plan does not allow a call to an executable, so I have had to run a T-SQL task that utilises xp_cmdshell to call the script (xp_cmdshell will need to first be enabled on the SQL Server). I also have another version of the script for the system databases. This requires a modification to the two lines that test the folder names:

if SubFolder.Name <> "master" and SubFolder.Name <> "model" and SubFolder.Name <> "msdb" then

becomes

if SubFolder.Name = "master" or SubFolder.Name = "model" or SubFolder.Name = "msdb" then

dim fso, vPath, oFolder, vFullPath, oSubFolder, vFile, vSource, vTarget, vDelFile
dim vLogPath, vLogFile, vFileCount, vSubject, vTo, vFrom
Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
'set the path containing the folders & backup files to parse
vPath = "C:\Test\"
 
'ZIP all backups created today & delete BAK files
'------------------------------------------------
 
set fso = CreateObject("Scripting.FileSystemObject")
 
set oFolder = fso.getfolder(vPath)
for each SubFolder in oFolder.SubFolders
	if SubFolder.Name <> "master" and SubFolder.Name <> "model" and SubFolder.Name <> "msdb" then
		vFullPath = vPath & SubFolder.Name & "\"
		set oSubFolder = fso.getfolder(vFullPath)
		set oFiles = oSubFolder.Files
		for each oFile in oFiles
			if datevalue(oFile.DateLastModified) = datevalue(Date) and right(oFile.Name,3) = "bak" then
				vSource = vFullPath & oFile.Name
				vTarget = replace(vSource,".bak",".zip")
				vDelFile = 0
				vDelFile = Zip(vSource,vTarget)
				if vDelFile = 1 then
					oFile.Delete
				end if
			end if
		next
	end if
next
 
'Log all files in appropriate backup folders & email to sql operators
'--------------------------------------------------------------------
 
vLogPath = "C:\Test\"
vLogFile = "user_db_backup.log"
vSubject = "SERVER Backup Status - User DBs"
vTo = "test@backup.co.uk"
vFrom = "server@backup.co.uk(Server Backup Job)"
 
' Create the status file
Set oStatusFile = fso.OpenTextFile(vLogPath & vLogFile, ForWriting, True)
oStatusFile.WriteLine("Server Backup Status - User DBs - " & Date)
oStatusFile.WriteLine("=======================================================")
oStatusFile.WriteLine("")
 
for each SubFolder in oFolder.SubFolders
	if SubFolder.Name <> "master" and SubFolder.Name <> "model" and SubFolder.Name <> "msdb" then
		vFullPath = vPath & SubFolder.Name & "\"
		oStatusFile.WriteLine(vFullPath)
		set oSubFolder = fso.getfolder(vFullPath)
		set oFiles = oSubFolder.Files
		vFileCount = 0
		for each oFile in oFiles
			oStatusFile.WriteLine("     " & oFile.Name)
			vFileCount = vFileCount + 1
		next
		if vFileCount = 0 then
			oStatusFile.WriteLine("     " & "*** NO FILES IN THIS FOLDER ***")
		end if
		oStatusFile.WriteLine("")
		oStatusFile.WriteLine("-------------------------------------------------------")
	end if
next
 
oStatusFile.Close
Set oStatusFile = Nothing
 
SendStatus vSubject,vLogPath & vLogFile,vFrom,vTo
 
set oFiles = nothing
set oSubFolder = nothing
set oFolder = nothing
set fso = nothing
 
WScript.Quit
 
 
Function Zip(sFile,sArchiveName)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com
 
  Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
  Set oShell = WScript.CreateObject("Wscript.Shell")
 
  '--------Find Working Directory--------
  aScriptFilename = Split(Wscript.ScriptFullName, "\")
  sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
  sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
  '--------------------------------------
 
  '-------Ensure we can find 7z.exe------
  If oFSO.FileExists(sWorkingDirectory & "\" & "7z.exe") Then
    s7zLocation = ""
  ElseIf oFSO.FileExists("C:\Program Files\7-Zip\7z.exe") Then			'for 32bit OS
    s7zLocation = "C:\Program Files\7-Zip\"								'for 32bit OS
'  ElseIf oFSO.FileExists("C:\Program Files (x86)\7-Zip\7z.exe") Then	'for 64bit OS
'    s7zLocation = "C:\Program Files (x86)\7-Zip\"						'for 64bit OS
  Else
'  Error: Couldn't find 7z.exe
    Zip = 0
    Exit Function
  End If
  '--------------------------------------
 
  oShell.Run """" & s7zLocation & "7z.exe"" a -tzip -y """ & sArchiveName & """ " _
  & sFile, 0, True   
 
  If oFSO.FileExists(sArchiveName) Then
    Zip = 1
  Else
'    Error: Archive Creation Failed.
    Zip = 0
  End If
End Function
 
'Send email notification with status file as body ofemail.
Function SendStatus(strSubject,strBodySource,strFrom,strTo)
	Dim vSendFile, vBodyText, objMessage
	
	Set vSendFile = fso.OpenTextFile(strBodySource,ForReading)
	vBodyText = vSendFile.ReadAll
	vSendFile.Close
	Set vSendFile = Nothing
	
	Set objMessage = CreateObject("CDO.Message")
	objMessage.Subject = strSubject
	objMessage.From = strFrom
	objMessage.To = strTo
	objMessage.TextBody = vBodyText
	
	'==This section provides the configuration information for the remote SMTP server.
	'==Normally you will only change the server name or IP.
	objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	'Name or IP of Remote SMTP Server
	objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "MAINT70"
	'Server port (typically 25)
	objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	
	objMessage.Configuration.Fields.Update
	'==End remote SMTP server configuration section==
	
	objMessage.Send
	
	set objMessage = Nothing
	
End Function

Open in new window

0
 
SHardyAuthor Commented:
Krystian / Jeff: So long as there are no objections(?), I will split the points between you 150/100. Although there were no solutions given, your comments were helpful to me, especially in the decision to give up on the Windows compression and to use a 3rd party app.

BTW, Jeff, the link you gave does not appear to point to a compression tool, but rather to an opensource IDE. I no longer need the correct link, as 7Zip seems to do the required job. But it would have been good to be able to compare your chosen app to this one.

Thanks again,
Simon
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 8
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now