Zip file within VBA

Hello again Experts,

Have the following code and it works great. Basically, it imports any .csv data from the InputDir into a table. Once done, it transfers the .csv file to an archive directory.

However, am wishing to add some additional code before the transfer.

Public Sub Import()

' Define strings
Dim InputDir, ImportFile As String, tblName As String, Importspec As String, DestFolder As String

' Define string values
Importspec = "Import_Spec"
InputDir = "C:\User\Data\"
ImportFile = Dir(InputDir & "*.csv")
DestFolder = "C:\User\Data\Archive"
tblName = "temp_tbl_Data"


If MsgBox("Are you sure you want to import?", vbQuestion + vbYesNo + vbCritical, "Import data?") = vbYes Then
    ' Checks if any files exists. If no files exists, message box appears
    If Len(ImportFile) = 0 Then
    MsgBox "No files exist within folder. Unable to import.", vbCritical + vbOKOnly, "Import Error!!!"
    Exit Sub
    End If
    
    DoCmd.SetWarnings False
    ' If files exists, clear out temp_tbl_Data then import
    Do While Len(ImportFile) > 0
    DoCmd.OpenQuery ("qry_Data_Clear")
    
    ' Create zip file
    
    
    DoCmd.SetWarnings True
    ' Move the imported file to Archive
    Name InputDir & "\" & ImportFile As DestFolder & "\" & ImportFile
    
    ImportFile = Dir
    Loop
    MsgBox "SUCCESS - Data imported!", vbInformation, "Data Uploaded!"
Else
    Exit Sub
End If

End Sub

Select allOpen in new window

Sourced the following code within EE to do this, but need to make some adjustments so as to take into account the ImportFile string which specifies the .csv file. Any help would be greatly appreciated.

Sub ZipUp()
    Call Compress("C:\User\Test.zip", "C:\User\Test.txt")
End Sub

Sub Compress(strTargetPath As Variant, Fname As Variant)
  '/ incoming parameters must be declared as Variants
    
    If Dir(strTargetPath) <> "" Then Kill strTargetPath
    
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    Dim strZip As String
    strZip = strTargetPath

    Dim zipFil As Variant
    Set zipFil = objFSO.CreateTextFile(strZip)
    zipFil.WriteLine Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
    zipFil.Close
    ' Zip file is successfully created
    
    Dim oApp As Object
    Set oApp = CreateObject("Shell.Application")
    
    oApp.namespace(strTargetPath).CopyHere Fname
    
    Set oApp = Nothing
    Set objFSO = Nothing
    
End Sub

Select allOpen in new window

Regards

LK