Attribute VB_Name = "basZip_Unzip"
Option Compare Database
Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Sub Unzip(varZipFile, varTargetFolder)
'Purpose  : Unzip file using default Win XP zip program.
'           Can also be used as is for VBScript.
'DateTime : 12/12/2007 12:55
'Author   : Bill Mosca
    Dim oApp
    Dim varItem
    Dim fs
    
    'Check that folder ends with "\"
    If Right(varTargetFolder, 1) <> "\" Then
        varTargetFolder = varTargetFolder & "\"
    End If
    
    Set oApp = CreateObject("Shell.Application")
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    'Kill file if any exists.
    For Each varItem In oApp.NameSpace(varZipFile).Items
        If fs.FileExists(varTargetFolder & varItem.Name) = True Then
            fs.DeleteFile (varTargetFolder & varItem.Name), True
        End If
    Next
    
    'Copy the files in the newly created folder
    oApp.NameSpace(varTargetFolder).CopyHere oApp.NameSpace(varZipFile).Items

    'Delete temp folder if it exists.
    On Error Resume Next
    fs.deletefolder Environ("Temp") & "\Temporary Directory*", True
    
    Set fs = Nothing
    Set oApp = Nothing

End Sub

Public Function Zip(varSourceFile, varZipFile)
    Dim fs As FileSystemObject
    Dim oApp
    Dim oTxt
    Const FOR_WRITING = 2
    
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set oApp = CreateObject("Shell.Application")
    
    If Dir(varZipFile) <> "" Then Kill varZipFile
    
    'Create text file for zipping.
    Set oTxt = fs.OpenTextFile(varZipFile, FOR_WRITING, True)
    'This is the string that must be in a zipped file.
    oTxt.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
    oTxt.Close
    Set oTxt = Nothing
   
    ' Copy the file to the compressed folder
    oApp.NameSpace(varZipFile).CopyHere varSourceFile
    
'*********If zipping all files in source folder, use this code**************
'           Make necessary changes such as parameter: folder instead of file
'
'    ' Make sure the path ends with a backslash
'    If Right(varFolder, 1) <> "\" Then
'        varFolder = varFolder & "\"
'    End If
'
'    ' Copy the files to the compressed folder
'    objApp.NameSpace(myZipFile).CopyHere objApp.NameSpace(varFolder).Items
'
'    ' Keep script waiting until compression is done
'    Do Until oApp.NameSpace(varZipFile).Items.Count _
'           = oApp.NameSpace(varFolder).Items.Count
'        Sleep 200
'    Loop
''*******************************************************************************
 
        
    Set fs = Nothing
    Set oApp = Nothing

End Function