Solved: Compressing files

[Poundland]

Dear all,
I have written some code that takes a selection of data and calculations from other files, and saves them as a new workbook in several places.
My problem is that one of the places where the work book is saved to is a restricted memory folder, and I need to be able to Zip the file when it saves.

Is there some code that will allow me to save a file as a .zip extension and will compress the file, or some code that will take the saved workbook and zip it?

Thanks

[RonMcK]

Since you marked your query as solved (with no replies) it would be helpful to the rest of us if you would edit your query, adding a brief explanation of how you solved your problem.

Thanks!

[georgiboy]

This would be nice as i was working on this.

[Poundland]

Since you marked your query as solved (with no replies) it would be helpful to the rest of us if you would edit your query, adding a brief explanation of how you solved your problem.

Thanks!

Apologies...

My situation, I have an extensive Macro as explained above and I wanted to Zip the resulting saved file, I do not have WinZip on my PC, but have another Compression tool called AlZip.

My resolution to this issue was this set of code. This code compresses a named file into either an existing Zip file or creates a Zip file at the time of compression. Use this outside of your main code and reference it in your main code.

Public Function Zipp(ZipName, FileToZip)
'Zips A File
'ZipName must be FULL Path\Filename.zip - name Zip File to Create OR ADD To
'FileToZip must be Full Path\Filename.xls - Name of file you want to zip
Dim FSO As Object
Dim oApp As Object
If Dir(ZipName) = "" Then
Open ZipName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(ZipName).CopyHere (FileToZip)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(ZipName).items.count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function

Use this code in your main Macro to reference and run the Compression code above.

'''''Kills Yesterdays Zip file''''''''''''
Kill "I:\H925 Buying\E Rowe - Hong Kong\Department Exception reports\Department Import Exception Tracker " & strDate & ".zip"

''''''''' Saves the file as an .xls extension''''''''
ActiveWorkbook.SaveAs ("I:\H925 Buying\E Rowe - Hong Kong\Department Exception reports\Department Import Exception Tracker " & strDate & ".xls")

' Calls the zip code and defines the Zip folder to add, and the folder to add to it
Call Zipp("I:\H925 Buying\E Rowe - Hong Kong\Department Exception reports\Department Import Exception Tracker " & strDate & ".zip", "I:\H925 Buying\E Rowe - Hong Kong\Department Exception reports\Department Import Exception Tracker " & strDate & ".xls")

' Kills the .xls file that has just been zipped
Kill "I:\H925 Buying\E Rowe - Hong Kong\Department Exception reports\Department Import Exception Tracker " & strDate & ".xls"


I found this code on another website, and my only claim is that I modified it for my circumstances.

Hope this helps.

[RonMcK]

Yes, thank you very much!