troubleshooting Question

Zip file within VBA

Avatar of lkirke
lkirkeFlag for Australia asked on
Microsoft Access
5 Comments1 Solution663 ViewsLast Modified:
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
    MsgBox "SUCCESS - Data imported!", vbInformation, "Data Uploaded!"
    Exit Sub
End If

End Sub

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\", "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)
    ' 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



Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 5 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 5 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros