Problem Creating a usable zip file using VBA. Does anyone have an alternative?

Occasional Contributor

I am hitting a problem creating a usable zip file using VBA. 

I am using the following code block to create a zip file. I found it in virtually all internet posts that I came across and for that, I copied it with high confidence that it will work. But it's not working as expected when the storage device is a MicroSD or Flash Drive. the sub-routine works fine if the storage device is an internal hard drive, portable hard drive (HDD) or portable solid-state drive (SSD)

 

sub Create_Zip_File (argDestZipPath as Variant)

    Open argDestZipPath For Output As #1 'Create an empty zip file
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1

end sub

 

The sub-routine does create an empty zip file on a Flash Drive or MicroSD storage device on the specified path, but I can't open it either manually or with vba code. I get the following prompt as I manually click on the zip file icon in the window or as I attempt to utilize the shell.CopyHere method using the statements below.

 

    Set ShellApp = CreateObject("Shell.Application")
    ShellApp.Namespace(argDestZipPath).CopyHere ShellApp.Namespace(argItemToZipPath)

 

PromptOnZipFile.png

 

In comparison, I can manually create an empty zip file in the same location on the Flash or MicroSD and can successfully open the resulting file by manually clicking the icon or by way of vba code without incurring the prompt. I can also create the empty zipped file on the hard drive, then move it to the flash drive or MicroSD where it works normally without incurring the prompt. The problem occurs only when the subroutine creates the zip file directly to the FlashDrive or MicroSD.

 

Background

I am using Windows 10 (Home), with the most recent updates, and am using MS Access in an Office 365 subscription that I believe is also up to date. I have a 64bit machine. The MicroSD card and flash drive are formatted as NTFS.

 

I suspect there is an alternative to the Print statement that creates the zip file that will configure the zipped file exactly as does the manual procedure available on the windows explorer shortcut menu

 

Does anyone know an alternative to the following?

    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)

 

My current vba workaround is to automatically create the empty zip file on the hard drive, then move copy (via FileSystemObject class) a pre-existing empty zipfile.zip on the hard drive to the MicroSD or Flash drive, then renaming it according to characteristics of the intended content before proceeding to send files to it. This is effective as a stop-gap but certainly not preferred.

9 Replies
I made a correction to the stated workaround. The correct technique is in green.

Let’s say you want to make a backup of your database and email a copy to somewhere – as a backup on the same machine isn’t much use.

If you don't want to email it don't add that section of code to your button.

 

Here’s a simple method I used to use.  I don’t anymore as we now have a different system in place, but this will start you off in the right direction.

 

I use MS Outlook, so if you don’t you’ll need to alter the code to use whatever mailing system you do use.

 

 

First
Create a form with a button – call it   cmd_backup

Next create a macro – call it   mcr_Backup

Next create a module – call it   mod_Backup

 

In the module paste this and save it (I didn’t write this, I’ve changed a few lines from the original which I can't remember where I got it from)

Option Compare Database
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function SendTheBackUp () As Long
    Dim ShellApplication    As Object
    Dim CurrentProjectFile  As String
    Dim ZipPath             As String
    Dim ZipName             As String
    Dim ZipFile             As String
    Dim FileNumber          As Integer
    CurrentProjectFile = CurrentProject.Path & "\" & CurrentProject.Name
    ZipPath = CurrentProject.Path & "\_My_backup_created_on_" & Format(Date, "mm-dd-yyyy") & "_at_" & Format(Time, "hh-mm")
    ZipName = ".zip"
    ZipFile = ZipPath & ZipName

    If Dir(ZipPath, vbDirectory) = "" Then
        MkDir ZipPath
    End If
    FileNumber = FreeFile
    Open ZipFile For Output As #FileNumber
    Print #FileNumber, Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, vbNullChar)
    Close #FileNumber

    Set ShellApplication = CreateObject("Shell.Application")
    With ShellApplication
        Debug.Print Timer, "zipping started ..."
        .NameSpace(CVar(ZipFile)).CopyHere CVar(CurrentProjectFile)
        On Error Resume Next
        Do Until .NameSpace(CVar(ZipFile)).Items.Count = 1
            'DoEvents
            Sleep 100
            Debug.Print " .";
        Loop
        Debug.Print
        On Error GoTo 0
        Debug.Print Timer, "Zip done."
    End With
    Set ShellApplication = Nothing
    ZipCurrentProject = Err.Number
End Function



Next in the macro call the module (can be done in VBA but simpler to see what is going on if it’s in a macro)

 

Action = RunCode
Arguments = SendTheBackUp()
Function Name = SendTheBackUp

 

Next code the button to send the back up somewhere –

 

 

Private Sub cmd_backup_Click()
    DoCmd.RunMacro "mcr_Backup", , ""
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim strpath As String
    Dim varMail As Variant
    Dim varMailCC As Variant
    Dim varSubject As Variant
    Dim varcontact As Variant
    Dim varBody As Variant
    
    strpath = "This is where the file will go to "
    strfile = CurrentProject.Path & "\_My_Back_created_on_" & Format(Date, "mm-dd-yyyy") & "_at_" & Format(Time, "hh-mm") & ".zip"
‘of course you can take the details (mail address, name, etc) from the form controls if you prefer, but I have hard coded them below to show you where the details are.
     varMail = "Email address removed"
    varMailCC = "Email address removed"
    varSubject = "Hey, I've made a backup"
    varcontact = "Some name here"
    varBody = "<P><font face=calibri color=Black style= font-size:20px>  " & varcontact & " <p>A backup has been created." & Chr(13) + Chr(10) & Chr(13) + Chr(10) _
    & "Add more information here if you want to.</p>"
        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)
        With MailOutLook
            .BodyFormat = olFormatRichText
            .To = varName
            .CC = varCC
            .Subject = varSubject
            .HTMLBody = varBody
            .Attachments.Add (strfile)
            .Display
         End With         
End Sub

 

Hope this helps

K

Thank you  @karenlorr_uk 

While my needs are different, the code I have (with variations to fit my needs) is roughly the same as yours. However, my problem is in the zip file that gets created when the value of 'ZipFile' in the code block below is a path onto a flash drive or MicroSD card. 

 

    Open ZipFile For Output As #FileNumber
    Print #FileNumber, Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, vbNullChar)
    Close #FileNumber

The created zip file has some sort of access gate that requires an unknown, non-existent disk. This happens on virtually every flash drive and MicroSD on which I have tried to create such a zip file.

RBStewart_0-1647467408467.png

 

My vb code workaround is simply to copy a pre-existing, empty zip file that was created on an internal hard drive onto the portable storage device. Such a copy works fine. I can access it, send files to it extract files from it as needed, and without the pesky gate calling for a non-existent disk.

 

Thank you for taking the time to offer this suggestion.

You're right - and I don't know why.
I have just created a small sample database with just 1 module and form and I get the same warning message as you (this was on a new USB - so n hidden folders) if the path is directed to a zip folder. But it works fine on a hard drive.

I get the same problem even after a full format of the USB.

So the VBA works OK and it's not an Access VBA problem.

Sorry I can't be of any more help with this. Maybe it would be a good idea to post in the Windows forum and see if there are any work-arounds. Of course you could just write the backup to your hard drive and then, in the same module, move the folder to the USB, but this starts to get messy and there really shouldn't be a need to do this.

@karenlorr_uk 

Two questions about your SendThe Backup function

1. Why are you creating an empty folder with the same name as the zip file? 

It seems to be unnecessary

These 3 lines can be removed & the zip file is still created correctly

   If Dir(ZipPath, vbDirectory) = "" Then
        MkDir ZipPath
   End If

 

2. The final line doesn't compile so I removed it

ZipCurrentProject = Err.Number

Does it have any purpose?

@RBStewart 

Strange procedure

I used this : https://github.com/wqweto/ZipArchive

pure VB6 code to create zips and it works just great...no calling Shell and tricks

tsgiannis,
The sample vb6 functions using the cZipArchive class that are shown in your linked github post look great in their simplicity. But I am having a problem identifying the specific library to download so as to try it out. My preference is to include it in the database references for early binding, keeping the library resident in the application parent path. Will you please share the specific name of the library you are using?

@RBStewart 

I am attaching the class file to import to Access

The usage is like this

Dim czip As New CzipArchive

With czip
.AddFile B, "YourFile.ext  ' Just put your file
 
.CompressArchive baZip, , 1
Debug.Print "End: " & Now()
End With

@RBStewart 

I could replicate your issue, and modified my zip function to handle it:

 

VBA.Compress 

 

The method used is simply to create the zip file in the temp folder and, when done, copy it to the removable drive.