Zip files from VBA using windows inbuilt compressing software

[UHNSTrust]

I am used to working with 'Winzip' and 'Winzip Command Line' from VBA coding.

I want to do zipping of files from my multiuser database. The problem is that not everybody has winzip. However we do all have windows built in zipping software.

Can anybody help with code to help automate zipping a file using the windows compression software?

Thanks in advance for any help.

Jonathan

 

[Remou]

Hi
I have tried the code below, and it seems to work ok. It is a modified version of the zip code that can be found here

http://www.rondebruin.nl/windowsxpzip.htm

Zip file or files with the default Windows XP zip program (VBA)
Ron de Bruin (last update 24 Sept 2005)

Sub Zip_File()
  Dim strDate As String, DefPath As String
    Dim oApp As Object
    Dim FName, FileNameZip
 
    DefPath = CurrentProject.Path
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If
 
    strDate = Format(Now, " dd-mmm-yy h-mm-ss")
    FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"
 
    FName = "C:\Data\db1.mdb"
    
    'Create empty Zip File
    NewZip (FileNameZip)
 
    Set oApp = CreateObject("Shell.Application")
 
    oApp.NameSpace(FileNameZip).CopyHere FName
      
    MsgBox "You find the zipfile here: " & FileNameZip
    Set oApp = Nothing
End Sub

Sub NewZip(sPath)
'Create empty Zip File
    Dim oFSO, arrHex, sBin, i, Zip
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
                   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
    For i = 0 To UBound(arrHex)
        sBin = sBin & Chr(arrHex(i))
    Next
    With oFSO.CreateTextFile(sPath, True)
        .Write sBin
        .Close
    End With
End Sub

 

[UHNSTrust]

Remou,

Thanks for the reply. I am still having problems.

My code is;

Sub Zip_File()
    Dim oApp As Object
    Dim FName, FileNameZip
 
    FileNameZip = "\\walnhs03\Informatics\InformaticsData\Waiting_Lists\WEEKLY_KH07\WeeklyWT_2005.10.02.zip"
        
    FName = "C:\InformationDB\WTWorkFolder\ImportFiles\GPWTG.TXT"
    
    'Create empty Zip File
    NewZip (FileNameZip)
 
    Set oApp = CreateObject("Shell.Application")
 
    oApp.Namespace(FileNameZip).CopyHere FName

    MsgBox "You find the zipfile here: " & FileNameZip
    Set oApp = Nothing
End Sub

The zip file is getting created perfectly but then I get the message 'Confirm File Replace'. This asks if I want to replace the zip file with my txt file. I have tried pressing yes and no but as soon as I do I get the error Method 'copyhere' of object 'Folder2' failed.

I am scratching my head!! I have tried the examples on the web site that you provided the link for. I am using windows 2000. Is this going to be the problem or are there any other ideas??

Thanks for any help provided.

Jonathan

 

[Remou]

Sorry, I'm lost.