Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Zip Files Function Help 1

Status
Not open for further replies.

dssjon

MIS
May 29, 2007
37
US
Hello, I have a working zip function that zips all files in a directory into one zip file. I need the function to zip only files I specify from a record set that contains file path/name of text files. I have tried to call the function and pass in values from a recordset but once it creates the zip it can't write over itself and crashes. Does anyone know of any way I accomplish my goal? It would be a lifesaver.




working code:
Code:
Function ZipFolder(varFolderName_SOURCE_COMPLETE As Variant, varFileName_DESTINATION_COMPLETE As Variant) As String
'Arguments should be like "C:\TestFolder", "C:\TestFile.zip"
'Function should be used like this:
'Dim strZipFolder_RETURNVALUE As String
'   strZipFolder_RETURNVALUE = ZipFolder("C:\TestFolder", "C:\TestFile.zip")
'   If Left(strZipFolder_RETURNVALUE, 7) <> "Success" Then ...
DoCmd.SetWarnings False
'On Error GoTo Error_Handler

Dim objFSO As New FileSystemObject
Dim objEmptyZIPFile As TextStream
Dim objShellApplication As Object
Dim objFile_DESTINATION As Variant
Dim objFolder_SOURCE As Variant

    'Create an empty ZIP file
    Set objEmptyZIPFile = objFSO.OpenTextFile(varFileName_DESTINATION_COMPLETE, ForAppending, True)
    objEmptyZIPFile.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
    objEmptyZIPFile.Close
    Set objEmptyZIPFile = Nothing

    'Create Application object
    Set objShellApplication = CreateObject("Shell.Application")
    
    'Define Destination_File and Source_Filder
    Set objFile_DESTINATION = objShellApplication.NameSpace(varFileName_DESTINATION_COMPLETE)
    Set objFolder_SOURCE = objShellApplication.NameSpace(varFolderName_SOURCE_COMPLETE).Items

    'Copy the files to the compressed folder
    objFile_DESTINATION.CopyHere objFolder_SOURCE, 256

    'Keep code waiting until compression is done and file is moved from cache to destination
    Do Until objFile_DESTINATION.Items.Count = objFolder_SOURCE.Count
        Wait
    Loop

'Error_Handler:
    
    'MsgBox Err.Number & " " & Err.Description
  

    'Release objects
    Set objFSO = Nothing
    Set objShellApplication = Nothing
    Set objFile_DESTINATION = Nothing
    Set objFolder_SOURCE = Nothing
    DoCmd.SetWarnings True
End Function

my test code (which does not work in several ways, may be best to just ignore this):

Code:
Function procPROCESS1AND2() As String


'On Error GoTo error
    DoCmd.SetWarnings False
    'Move Files to zip directory
    Dim rs As Recordset
    Dim fso As New FileSystemObject
    Dim strSource As String
    Dim strDest As String
    Dim strSql As String
    Dim strZipFolder_RETURNVALUE As String
    
    Dim objShellApplication As Object
    Dim objFile_DESTINATION As Variant
    Dim objFolder_SOURCE As Variant
    
    strSql = "SELECT * FROM tblPROCESS1AND2"
    
    Set rs = CurrentDb.OpenRecordset(strSql)
    
    Do While Not rs.EOF
        strSource = rs.Fields("Source").Value
        strDest = rs.Fields("Destination").Value
        Set objShellApplication = CreateObject("Shell.Application")
    
        'Define Destination_File and Source_Filder
         Set objFile_DESTINATION = objShellApplication.NameSpace(strDest)
         Set objFolder_SOURCE = objShellApplication.NameSpace(strSource)
         objFile_DESTINATION.CopyHere objFolder_SOURCE, 256
    
        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    
    'Move Pugh.txt
'error:
         'MsgBox Err.Number & " " & Err.Description
    DoCmd.SetWarnings True
End Function


 
Doing zips using the Shell is novel and may give you the sense that you are making the most of the OS however the Shell tends to change with each encarnation of Windows, I expect you are developing under XP; if so the code is unlikely to work under W2k, and may not work under Vista. The facilities available in creation of zips is also pretty limited e.g. I don't think encryption is possible.

I would recommend to go to info-zip.com and use one of their dlls or simply shell out to their zip.exe/ unzip.exe utilites which incude just about all the facilities offered by the original PkZip. God bless Phillip!
 
Much appreciated but I am not allowed to install third party software in our intranet. We can't even use winzip.
 
I am not allowed to install third party software
So, don't use third party file format ...
 
What would you suggest other than the built in windows compression?
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top