Compress Worksheet File...

mjschukas · Mar 5th 2007

i'm using the following code to compress a worksheet, but i get an error message that i would like to surpress...

Code

'zip
On Error Resume Next
Dim FileNameZip, FolderName
Dim strDate As String, DefPath As String
Dim oApp As Object
    DefPath = "c:\temp\salesmanMDB\ed\"
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If
FolderName = "c:\temp\salesmanMDB\ed\" '<< Change
FileNameZip = DefPath & "ed_CustomerItemHistory" & ".zip"
    'Create empty Zip File
    NewZip (FileNameZip)
    Set oApp = CreateObject("Shell.Application")
    'Copy the files to the compressed folder
    oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
    Set oApp = Nothing
End Sub


Sub NewZip(sPath)
On Error Resume Next
    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

Display More

???

thank you.

rbrhodes · Mar 6th 2007

Re: Compress Worksheet File...

Hi mj,

The message is "can't copy over itself" ?

Why not just use filecopy?

Cheers,

dr

mjschukas · Mar 6th 2007

Re: Compress Worksheet File...

ok...i'm thinking the compression works (above)...
and where would i use filecopy...?

???

thank you.

rbrhodes · Mar 6th 2007

Re: Compress Worksheet File...

Hi mj,

don't know if the compression works( didn't try it).

I just stepped thru yoursub and got the message "Can't copy file over itself" so I thought of 'filecopy'

[vba]
'compressed folder name
FolderName = "x\"
'name file
FileName = "ed.zip"
'path and filename
FileNameZip = DefPath & FileName

'Create empty Zip File
NewZip (FileNameZip)

'FILECOPY
'Copy the files to the compressed folder
FileCopy FileNameZip, DefPath & FolderName & FileName

[/vba]

Cheers,

dr

mjschukas · Mar 9th 2007

Re: Compress Worksheet File...

thank you for the thought and effort...

i just tried, no error message, but i also don't get the file compressed (it compresses, but with nothing in it...?

(here's what i changed--one line...:)
from

Code

oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items

to

Code

FileCopy FileNameZip, DefPath & FolderName & FileName

thank you...

rbrhodes · Mar 11th 2007

Re: Compress Worksheet File...

Hi,

Found this link on undocumented command line args for winzip:

http://www.memecode.com/docs/winzip.html

Incorporated that into a simple "Shell" command:

[vba]
Sub zipper()

Dim DefPath As String
Dim Filenam As String
Dim FileNameZip As String
Dim FolderNameZip As String

On Error Resume Next

DefPath = "c:\temp\salesmanMDB\ed\"

Filenam = "copy"

FolderNameZip = "c:\temp\salesmanMDB\ed\zipped\"

FileNameZip = DefPath & Filenam & ".zip"

Shell ("c:\program files\winzip\winzip32.exe -a " & FileNameZip & " " & DefPath & Filenam & ".xls")
'Shell ("c:\program files\winzip\winzip32.exe -a c:\temp\salesmanMDB\ed\copy.zip c:\temp\salesmanMDB\ed\copy.xls")

'Website with Winzip args
'http://www.memecode.com/docs/winzip.html

'Copy the files to the compressed folder
FileCopy FileNameZip, FolderNameZip & Filenam & ".zip"

End Sub[/vba]

HTH...

mjschukas · Mar 16th 2007

Re: Compress Worksheet File...

thank you...

i'm trying not to use winzip, etc.

but maybe, i can compress to a different folder, copy into the folder i need to, and then delete the old file...!

i will try on monday and get back asap...

thank you..!

mjschukas · Mar 19th 2007

Re: Compress Worksheet File...

some progress...! thank you...

i would now like to surpress the request "the folder already exists..."?

Code

Set oApp = CreateObject("Shell.Application")
        'Copy the files in the newly created folder
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).items

???

thank you.

rbrhodes · Mar 20th 2007

Re: Compress Worksheet File...

Have you tried:

[vba]
Application.displayalerts = false

...code...

Application.displayalerts = True

[/vba]

mjschukas · Mar 21st 2007

Re: Compress Worksheet File...

thank you...i like the idea, but the error message still pops up...

seemingly during the following code (when it finds a previous compressed file):

Code

oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
    'Keep script waiting until Compressing is done
    On Error Resume Next
    Do Until oApp.Namespace(FileNameZip).items.Count = oApp.Namespace(FolderName).items.Count
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop

rbrhodes · Mar 21st 2007

Re: Compress Worksheet File...

Hi mj,

I notice you've gone back to Namespace.copyhere rather than Filecopy.

Looks like you're copying the whole folder rather than just a single, newly created, file?

I can't really tell without seeing your whole sub...

Compress Worksheet File...

Participate now!

Share