Having a real funny problem.

[CD Tom]

Here's my problem, I have in my application a backup procedure that creates .txt files for each table. I use the docmd.transfertext to export the data. This creates a number of .txt files. I decided to zip those files up so that I only have a .zip file instead of many .txt files. I'm using Ken Jensen zip module, there are four modules basZip, khZip, khZipfile and khZipfiles this is working fine on 95% of my users however there a a couple that have a problem. Everything goes fine until the very last and then they get an error message that the zip file is empty. Now here comes the funny part. I've run the program on there computer and have stopped the code so I could step it through, when I do the step through it works fine but when I run it straight through I get the error. When I get the error the zip file isn't created, when I step through the code it works and I get the zip file.
I'm wondering if anyone has seen this type of problem, or maybe there is a better way of doing the zipping up instead of using Ken Jensens zip modules.
Thanks for any advise and help

[NeoPa]

It sounds like you may be suffering from some sort of race condition. Something that you rely on to be ready at such and such a point isn't.

Usually VBA is single-threaded so it's hard to guess what that might be, but adding DoEvents() function calls between files may well help.

Good luck Tom.

[CD Tom]

Is that all there is to the command is DoEvents().

[NeoPa]

CD Tom:
Is that all there is to the command is DoEvents().

I've no idea what you're trying to ask.

[PhilOfWalton]

Butting in, Tom is asking if there are any parameters with DoEvents() and the answer is no (and you don't even need the brackets).

DoEvents
 

Phil

[CD Tom]

I guess I figured that out, but I've tried everything to get this to work, by putting the DoEvents in many different places, But nothing seems to work. I can't seem to find where the error message is coming from. The following code is where I think the error is happening but like I said when I step through the process it works just fine.

Me.ZipFilePath_Temp = "C:\Temp\" & Right$(Me.ZipFilePath, Len(Me.ZipFilePath) - InStrRev(Me.ZipFilePath, "\"))
 
        NewZip Me.ZipFilePath_Temp
 
        If Right$(Me.ZipFolderPath, 1) <> "\" Then
            Me.ZipFolderPath = Me.ZipFolderPath & "\"
        End If
 
        Set objShell = CreateObject("Shell.Application")
        Set objFolder = objShell.Namespace(Me.ZipFilePath_Temp)
        Set objFolder2 = objShell.Namespace(Me.ZipFolderPath)
 
        objFolder.CopyHere objFolder2.Items
        'Keep script waiting until Compressing is done
        On Error Resume Next
        Do Until objFolder.Items.Count = objFolder2.Items.Count
            DoEvents
        Loop
 
        On Error GoTo Err_ZipAll
 
        If Len(Dir(Me.ZipFilePath)) > 0 Then
            Kill Me.ZipFilePath
        End If
        Name Me.ZipFilePath_Temp As Me.ZipFilePath
    End If
 

Any ideas where to slow this down.

[NeoPa]

Hi Tom.

This is the first time we've seen your code, which is strange considering this is what you're asking for help with.

My first comment would be that using scripting to handle this is unnecessary. There is a Shell() function available in VBA that allows you to run Command Line commands. I have also written, for situations just such as this where it's important to ensure the process is completed before allowing the VBA to continue, a version called ShellWait().

My second comment would be that you have inserted the DoEvents() calls into your code intelligently so if that isn't working then that doesn't seem to be the solution.

We all have our own preferred ways of doing things and I prefer to use standard VBA calls where they're available rather than scripting objects.

[CD Tom]

Thanks for your response. Seeing this is the first time I've tried to do anything like zipping up files I didn't have any idea what to do. I looked and found what I thought was the best answer, but I guess I'm finding out it wasn't. I'm not sure VBA calls to use, Shell() and shellWait() sound like a good start. Where can I find more information on how to use these with my zipping problem. I appreciate all your help and information. I keep learning things from you guys. Thanks lots.

[NeoPa]

Hi Tom.

I don't know your Zipping program so all I can say at this point is that Shell(), and ShellWait(), are both calls that allow you to run programs in the same way as you might from a Command Prompt. That means a BAT or CMD file can be executed from there. Do you have, or can you create, such a file to execute the task you need to execute?

[CD Tom]

Ok, I've been trying different ways to do this zipping up and here's the code I've found to work.

Dim objFSO As Object, objZip As Object, objShell As Object
Dim objFolder As Object, objFile As Object
Dim sngStart As Single
Dim strPath As String, strZip As String
strPath = FolderName
 
strZip = strbkfoldername  'Output zip file
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objZip = objFSO.CreateTextFile(strZip)
objZip.WriteLine Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
objZip.Close
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objFSO.GetFolder(strPath)
DoCmd.Hourglass True
    'loop through files - adding them to the
For Each objFile In objFolder.Files
    If objFile <> strZip Then
    objShell.Namespace("" & strZip).CopyHere objFile.Path
    'objShell.Namespace("" & strZip).MoveHere objFile.Path
    sngStart = Timer
    Do While Timer < sngStart + 1
        DoEvents
    Loop
    End If
Next
DoCmd.Hourglass False
 

This works great when I select a disk drive. But if I select a jump drive I keep getting this message everytime it gets a file to zip. "Please insert the last disk of the Multi-volume set and click ok to continue"
There are 54 files that are being .copyhere so you end up clicking the OK 54 times. Can you see any way to eliminate this message?
Thanks again for any help

I've tried the .movehere also and get the same message.