Mar 14 2022 08:02 AM - edited Mar 14 2022 11:44 AM
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)
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.
Mar 14 2022 11:36 AM
Mar 15 2022 11:36 PM
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
Mar 16 2022 03:08 PM
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.
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.
Mar 16 2022 11:26 PM
Mar 21 2022 11:34 AM
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?
Mar 22 2022 12:47 AM
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
Mar 27 2022 11:00 AM
Mar 27 2022 11:18 AM
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
Mar 27 2022 12:59 PM
I could replicate your issue, and modified my zip function to handle it:
The method used is simply to create the zip file in the temp folder and, when done, copy it to the removable drive.