Link to home
Create AccountLog in
Avatar of TerenceHewett
TerenceHewett

asked on

Zipping a folder in Access 2003 using VBA

Hi experts,

I would like to zip up a folder on my C:\ drive. The folder is just a normal folder that you find in the C:\drive.

I had this code from a couple of years back I think, which came from Experts Exchange.  It works, but only if I am zipping up an MDB.  

Please could somebody help me with the code to so that it zips up the whole folder?

Thank you.

Terry
Private Sub Command0_Click()
Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create instance of FSO

Compress ("C:\FolderA")
Set objFSO = Nothing
End Sub


Sub Compress(fil)
    Dim strPath, strExt, strfile As String

    strPath = Left(fil, InStrRev(fil, "\"))     'Acquire Path
    strfile = Mid(fil, InStrRev(fil, "\") + 1)     'Acquire filename
    strExt = Mid(strfile, InStrRev(strfile, ".") + 1, 3)     'Acquire extension
    Dim strZip As String
    strZip = strPath & Replace(strfile, "mdb", "zip")

    Dim zipFil As Object

    Set zipFil = objFSO.CreateTextFile(strZip)
    zipFil.WriteLine Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
    zipFil.Close

    Dim oApp As Object


    Set oApp = CreateObject("Shell.Application")
    'oApp.NameSpace(strZip).CopyHere strPath & strfile
    oApp.NameSpace(CStr(strZip)).CopyHere strPath & strfile
    DoEvents

    Set oApp = Nothing
    Set zipFil = Nothing
    'uncomment next line to delete file after zipped
    'If objFSO.FileExists(strZip) Then objFSO.DeleteFile (fil) '- only delete source file is zip file is present
End Sub

Open in new window

Avatar of Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1)
Flag of United States of America image

test this



Private Sub Command0_Click()
Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create instance of FSO

Compress ("C:\FolderA")
Set objFSO = Nothing
End Sub


Sub Compress(fil)
    Dim strPath, strExt, strfile As String

    strPath = Left(fil, InStrRev(fil, "\"))     'Acquire Path
'    strfile = Mid(fil, InStrRev(fil, "\") + 1)     'Acquire filename
'    strExt = Mid(strfile, InStrRev(strfile, ".") + 1, 3)     'Acquire extension
    Dim strZip As String
    strZip = mid(fil,instr(fil,"\")+1)

    Dim zipFil As Object

    Set zipFil = objFSO.CreateTextFile(strZip)
    zipFil.WriteLine Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
    zipFil.Close

    Dim oApp As Object


    Set oApp = CreateObject("Shell.Application")
    'oApp.NameSpace(strZip).CopyHere strPath & strfile
    'oApp.NameSpace(CStr(strZip)).CopyHere strPath & strfile
    oApp.NameSpace(CStr(strZip)).CopyHere oApp.NameSpace(fil &"\").items
    DoEvents
    On Error Resume Next
    Do Until oApp.NameSpace(ZipFileName).Items.Count = _
                oApp.NameSpace(fil & "\").Items.Count
    DoEvents
    Loop
    On Error GoTo 0


    Set oApp = Nothing
    Set zipFil = Nothing
    'uncomment next line to delete file after zipped
    'If objFSO.FileExists(strZip) Then objFSO.DeleteFile (fil) '- only delete source file is zip file is present
End Sub

Open in new window

oops,

change this
strZip = mid(fil,instr(fil,"\")+1)

with
strZip = mid(fil,instr(fil,"\")+1) & ".zip"
Avatar of TerenceHewett
TerenceHewett

ASKER

Hi Cap, and thanks for your help.

I get a runtime error 424 object required on the following line:

Set zipFil = objFSO.CreateTextFile(strZip)

As a note, when I hover over strZip, it does give me "FolderA.zip", but zipFil is empty when hovered over.

Any ideas why?

Your help is really appreciated as usual.

Regards
Terry
change these lines

    Set zipFil = objFSO.CreateTextFile(strZip)
    zipFil.WriteLine Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
    zipFil.Close

with


        Open strZip For Output As #1
        Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
        Close #1
Hi Cap,

I get run time error 91 : object variable or with block variable not set on the following line:

oApp.NameSpace(CStr(strZip)).CopyHere oApp.NameSpace(fil & "\").Items

When I hover over "fil" I get the following exact text:

 "c:\folderA"

and when I hover over "strZip" I get the following exact text:

"FolderA.zip"  (does not contain the path)

Your continued help would be so appreciated on this. I am pulling my hair out.

Regards
Terry
Just to mention, in case it is relevant to the problem, I am using Win Vista Business.  

Regards,

Terry
ASKER CERTIFIED SOLUTION
Avatar of RgGray3
RgGray3

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
BTW:  I also use 3 global vars for my message boxes so you would need to modify the msgbox calls to suit your own style of coding
Thanks RgGray3,

I have set the references as instructed and I have debugged and no errors are reported.  Although - I get run time error 91 : object variable or with block variable not set when I run the code.

Any ideas to what i am doing wrong?

Regards
Terry
The 91 error in the post above highlights the following line of code:

    '---------------------------------------
    'Copy the files into the zip file
    '---------------------------------------
    ShellApp.NameSpace(strFpTargetFileName).CopyHere (strSourceFolder)

Not sure what I am doing wrong.
No matter - all fixed.  I was being thick as usual.

Regards

Terry
Sorry - manners....thank you very much for all the help.

Regards

Terry
Well...   It's funny because I was going nutz just a week ago with the same problem...
Found a series of routines that either were not complete or would not compile...

When I finally distilled what I had found I was suprised to realize how little code was actually involved...

Glad to help and share...

Rich