Anything Access

Auto Unzipping Files and Loading of Excel Files

We used this function to automatically unzip Excel files , the files had been sent by email and an outlook rule saved the attachments into a given folder

Function ProcessZippedDownloads()
Dim rst As Recordset
Dim tmpFromFolder As String
tmpFromFolder = "\\your-folder-name"
'get the new zip files from folder
Call upStatus("Receipts - Getting File List @" & Now())
Call ListFilesInFolder(tmpFromFolder)
'check for procesing folder
If Dir("C:\test", vbDirectory) = "" Then
    MkDir "c:\test"
End If
If Right(tmpFromFolder, 1) <> "\" Then
   tmpFromFolder = tmpFromFolder & "\"
End If
'process the file into the Receipts table son the server
Set rst = CurrentDb.OpenRecordset("Select * from tblFilesDownloaded where FTP_PRocessed<>-1", dbOpenDynaset, dbSeeChanges)
If rst.RecordCount = 0 Then
    Exit Function
    Set rst = Nothing
    Call upStatus("No files to Process ?? @" & Now())
End If
DoCmd.SetWarnings False
Do While Not rst.EOF
    Call upStatus("Processing File @" & rst!FTP_FileDownloaded)
    'unpack and save as excel
    If Dir(tmpFromFolder & rst!FTP_FileDownloaded) = "" Then
        MsgBox "Where is it ? " & tmpFromFolder & rst!FTP_FileDownloaded
        Call Unzipit(tmpFromFolder & rst!FTP_FileDownloaded)
        'load into receipts table
        DoCmd.OpenQuery "qryAddReceipts"
        'edit and mark as processed
        rst!FTP_Processed = -1
        FileCopy tmpFromFolder & rst!FTP_FileDownloaded, "C:\test\processed\" & rst!FTP_FileDownloaded
        Kill tmpFromFolder & rst!FTP_FileDownloaded
    End If
DoCmd.SetWarnings True
Call upStatus("Finished @" & Now())
End Function

The Unzipit function uses the Chilkat Component and Excel Automation to open and save the file into a specific folder and load the contents into an SQL database.
The unzipped Excel file in this case has the same name and is linked to the database which allows the data to be loaded using an access query.

Function Unzipit(tmpFile)
Dim zip As New ChilkatZip2
Dim success As Long
'  Any string unlocks the component for the 1st 30-days.
success = zip.UnlockComponent("Your License Code")
If (success <> 1) Then
    MsgBox zip.LastErrorText & vbCrLf
    Exit Function
End If
success = zip.OpenZip(tmpFile)
If (success <> 1) Then
    MsgBox zip.LastErrorText & vbCrLf
    Exit Function
End If
If Dir("c:\test\*.xls") <> "" Then
    Kill "c:\test\*.xls"
End If
If Dir("c:\test\*.mht") <> "" Then
    Kill "c:\test\*.mht"
End If
If Dir("c:\test\*.lxs") <> "" Then
    Kill "c:\test\*.xls"
End If
Dim unzipCount As Long
'  Returns the number of files and directories unzipped.
'  Unzips to /my_files, re-creating the directory tree
'  from the .zip.
unzipCount = zip.UnzipInto("c:\test")
If (unzipCount < 0) Then
    MsgBox zip.LastErrorText & vbCrLf
    tmpFile = "c:\test\" & Dir("c:\test\*.xls")
    FileCopy tmpFile, Left(tmpFile, Len(tmpFile) - 3) & "mht"
End If
Dim xlApp As Object
If fIsAppRunning("Excel") Then
    Set xlApp = GetObject(, "Excel.Application")
    Set xlApp = CreateObject("Excel.Application")
End If
Set xlApp = CreateObject("Excel.Application")
xlApp.workbooks.Open Left(tmpFile, Len(tmpFile) - 3) & "mht"
'xlApp.Visible = True
xlApp.DisplayAlerts = False
xlApp.activeworkbook.Saveas "c:\test\ReceiptImport.xls", FileFormat:=56
Set xlApp = Nothing
'MsgBox "Done processing " & tmpFile

End Function
Hi, I’m Pat