Avatar of lkirke
lkirke
Flag for Australia asked on

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

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
Microsoft Access

Avatar of undefined
Last Comment
lkirke

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
als315

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
lkirke

ASKER
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.
als315

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
lkirke

ASKER
Awesome.

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

Thank you.
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
lkirke

ASKER
Excellent feedback and solution.