locked
How to create a .zip file with VBA in WindowsXP without any third party software? RRS feed

  • Question

  • WindowsXP can open and create a zipped file.

    How to zip and unzip a file in VBA?

    Thanks for ur help.

    Friday, March 23, 2007 2:07 AM

All replies

  • Hello, iopcj.

    I have a vba code that zips active workbook.   

    but I don't know how to unzip it. the code is not my work. 

    the code uses Windows Shell that is the core to work.

    HTH.

    --------------------------------------------------------------------------

    Sub zip_activeworkbook()
        Dim strDate As String, DefPath As String
        Dim FileNameZip, FileNameXls
        Dim oApp As Object
     
        If ActiveWorkbook Is Nothing Then Exit Sub
        DefPath = ActiveWorkbook.Path
        If Len(DefPath) = 0 Then
            msgbox "Plz Save activeworkbook before zipping" & Space(12), vbInformation, "zipping"
            Exit Sub
        End If
       
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If
     
        'Create date/time string and the temporary xls and zip file name
        strDate = Format(Now, " dd-mmm-yy h-mm-ss")
        FileNameZip = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".zip"
        FileNameXls = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".xls"
     
        If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then
     
            'Make copy of the activeworkbook
            ActiveWorkbook.SaveCopyAs FileNameXls
     
            'Create empty Zip File
            newzip (FileNameZip)
     
            'Copy the file in the compressed folder
            Set oApp = CreateObject("Shell.Application")
            oApp.Namespace(FileNameZip).CopyHere FileNameXls
     
            'Keep script waiting until Compressing is done
            On Error Resume Next
            Do Until oApp.Namespace(FileNameZip).items.Count = 1
                Application.Wait (Now + TimeValue("0:00:01"))
            Loop
            On Error GoTo 0
     
            'Delete the temporary xls file
            Kill FileNameXls
     
            msgbox "completed zipped : " & vbNewLine & FileNameZip, vbInformation, "zipping"
     
        Else
            msgbox "FileNameZip or/and FileNameXls exist", vbInformation, "zipping"

        End If
    End Sub

    Private 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

    ---------------------------------------------

    • Proposed as answer by kbj.BD Tuesday, September 27, 2016 6:54 AM
    • Unproposed as answer by kbj.BD Tuesday, September 27, 2016 6:54 AM
    Friday, March 23, 2007 5:16 AM
  • Cool!

    Great!

    It's what I want!

    Does anyone else find another way?

    Friday, March 23, 2007 7:46 AM
  • Hi iopcj,

    I've just found where I refer it from.

    plz visit the following link:

    Zip file or files with the default Windows XP zip program (VBA)

    It will solve out your problem.

    Bye~

     

    Friday, March 23, 2007 8:04 AM
  • This does not seem to work with Access 2003. Is there some object library I need to include to get it to work? I get a run time error 91 when I try to reference the zip file object using the CopyHere attribute (method). I checked the installed libraries and the default appears to be VB6 as was stated somewhere else in here as being the necessary version.

    Thanks in advance.
    Wednesday, November 21, 2007 11:06 PM
  • Hi

    I am attempting to use the code in Access 2003 also. Have you managed to find a solution?

    Regards

    Meir R.
    Tuesday, August 19, 2008 3:40 PM
  • No, I never found a solution. I gave up looking and waiting. The project is over. My need is gone. Good luck!

     

    Bruce

     

    Friday, August 22, 2008 2:13 AM
  • Set reference to "Microsoft Shell Controls and Automation" (i.e. C:\WINNT\systems32\SHELL32.dll)

     

    Code Snippet

    Option Compare Database
    Option Explicit

     

    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

    Sub TestDateiZippen()

        DateiZippen "C:\TEMP\Example.xml", "C:\TEMP\Example.zip"

    End Sub

     

    Sub DateiZippen(NameDatei As String, NameZipDatei As String)
    '
    ' s. http://www.rondebruin.nl/windowsxpzip.htm

    ' Early binding, set reference to:
    '   Microsoft Shell Controls and automation (C:\WINNT\systems32\SHELL32.dll)
           
    ' a)
        Dim oapp As Shell ' Early binding, late binding as in the example (Dim oApp As Object) didn't work
        Set oapp = CreateObject("Shell.Application")
    ' or b)
    '    Dim oapp As New Shell
       
        NewZip (NameZipDatei)
       
        oapp.Namespace(NameZipDatei).CopyHere NameDatei
       
        On Error Resume Next
       
        Do Until oapp.Namespace(NameZipDatei).items.Count = 1
            Sleep 1000
        Loop
       
        On Error GoTo 0

    End Sub

     

    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

     

    Tuesday, December 2, 2008 9:09 AM
  • someone i have a visual basic design maked i want to zip and unzip files i have in the design this:

    Textbox1 where must stand the file

    Button1 to browse a file

    Button2 to start zipping or unzipping

    Radiobutton1/2 to choose if you want to zip or unzip a file (1 to zip 2 to unzip)

    can someone make a script for me i have holiday and will make it off

    pls the name of i is R7-ZIP®(dont take it u see the ®)

    • Proposed as answer by theinscripter Friday, August 26, 2011 5:45 PM
    Friday, August 26, 2011 5:44 PM
  • Hi SJOO,

    Its very useful. Could you please help to add password in the zip file?

    Tuesday, September 27, 2016 6:55 AM
  • Cool,but why the size of zipped folder is similar to the original ones?
    Tuesday, February 12, 2019 6:32 AM