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
rst.MoveFirst
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
    Else
        Call Unzipit(tmpFromFolder & rst!FTP_FileDownloaded)
 
        'load into receipts table
        DoCmd.OpenQuery "qryAddReceipts"
        'edit and mark as processed
        rst.Edit
        rst!FTP_Processed = -1
        rst.Update
        FileCopy tmpFromFolder & rst!FTP_FileDownloaded, "C:\test\processed\" & rst!FTP_FileDownloaded
        Kill tmpFromFolder & rst!FTP_FileDownloaded
    End If
    rst.MoveNext
Loop
 
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
Else
    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")
Else
    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
xlApp.Quit
Set xlApp = Nothing
'MsgBox "Done processing " & tmpFile

 
 
End Function