Zip file within VBA

lkirke
lkirke used Ask the Experts™
on
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

Open 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

Open in new window


Regards

LK
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Compress sub could be used only without Dir call (it is not reenterable), but you don't need it. Comment this string:
   'If Dir(strTargetPath) <> "" Then Kill strTargetPath

Your sub should be changed to:
Public Sub Import()

' Define strings
Dim InputDir As String, 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
    ' Create zip file
    Call Compress(DestFolder & "\" & Left(ImportFile, Len(ImportFile) - 4) & ".zip", InputDir & ImportFile)    
    DoCmd.OpenQuery ("qry_Data_Clear")
          
    DoCmd.SetWarnings True
    ' Move the imported file to Archive
    ' Here you can move or delete files
    ImportFile = Dir()
    Loop
    MsgBox "SUCCESS - Data imported!", vbInformation, "Data Uploaded!"
Else
    Exit Sub
End If

End Sub

Open in new window

Author

Commented:
Public Sub Import_Data_ALL()

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

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


If MsgBox("Are you sure you want to import data into DB?", 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 any information.", 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")
    DoCmd.TransferText acImportDelim, Importspec, tblName, InputDir & ImportFile, True
    ' Create zip file and move to Archive folder
    Call Compress(DestFolder & "\" & Left(ImportFile, Len(ImportFile) - 4) & ".zip", InputDir & ImportFile)
    ' Remove all rows from temp_tbl_Data
    DoCmd.OpenQuery ("qry_Data_Clear_Class")
    ' Append new information from temp_tbl_Data to tbl_Data
    DoCmd.OpenQuery ("qry_Data_Append")
    DoCmd.SetWarnings True
    ' Delete the file from Data directory
    Kill InputDir & "\" & ImportFile
           
    ImportFile = Dir()
           
    Loop
    MsgBox "SUCCESS - Data imported!", vbInformation, "Data Uploaded!"
Else
    Exit Sub
End If

End Sub

Open in new window

Excellent. Zips and compress the file. However, code breaks at

ImportFile = Dir()

with the following message:

Run-time error '5':

Invalid procedure call or argument


Assuming it has to do with the fact the file doesn't exist anymore. Have included the updated code.
Dir can be used only once in a sub:
ImportFile = Dir(InputDir & "*.csv")
ImportFileZip = Dir(InputDir & "*.zip") - Remove this line

Have you deleted Dir call in Compress sub?
And you already have slash in InputDir. Don't add it twice:
Kill InputDir & "\" & ImportFile

Author

Commented:
Awesome.

Removed the ImportFileZip = Dir(InputDir & "*.zip") line and all works. Treats me right for trying to get create. :)

Thank you.

Author

Commented:
Excellent feedback and solution.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial