Zipping Files 1

[Swi]

I have the following code and would like to display a progress and have shell wait until finished but I have not had any luck. Any ideas?

Thanks.

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim Template As String
Dim Job As String
Dim TotalCnt As Long


Private Sub Command1_Click()
    Template = "C:\" & Format$(Date, "YYYYMMDD") & "_MCS_Template_Backup.zip"
    CreateEmptyZip Template
    With CreateObject("Shell.Application")
        .NameSpace(Template).CopyHere .NameSpace("\\999.999.9.999\c$\MCS\MCS Template").Items
        ' Keep script waiting until Compressing is done
        TotalCnt = .NameSpace("\\999.999.9.999\c$\MCS\MCS Template").Items.Count
        On Error Resume Next
        Do Until .NameSpace(Template).Items.Count = TotalCnt
            DoEvents
            lblStatus.Caption = "Count = " & .NameSpace(Template).Items.Count
            Sleep 100
        Loop
        On Error GoTo 0
        MsgBox "Done!", vbInformation
    End With
End Sub

Public Sub CreateEmptyZip(sPath)
    Dim strZIPHeader As String
    strZIPHeader = Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    With CreateObject("Scripting.FileSystemObject")
        .CreateTextFile(sPath).Write strZIPHeader
    End With
End Sub

Swi

 

[HughLerwill]

Not quite sure why you need the wait; the following gives me the required progress bar

'ref tek tips thread222-1302498

'if variables are used as arguments to .NameSpace they should be Variants, Strings will give an error 91

Private Sub CbZip_Click()

    CreateEmptyZip CurDir$ & "\testzip.zip"
    
    With CreateObject("Shell.Application")
    
        .NameSpace(CurDir$ & "\testzip.zip").CopyHere .NameSpace("C:\FolderWithLotsOfFiles").Items 'use this line if we want to zip all items in a folder into our zip file
    End With
    
End Sub

Private Sub CreateEmptyZip(sPath)
    Dim strZIPHeader As String
    
    strZIPHeader = Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) ' header required to convince Windows shell that this is really a zip file
    With CreateObject("Scripting.FileSystemObject")
        .CreateTextFile(sPath).Write strZIPHeader
    End With
    
End Sub

 

[Swi]

It does provide a status bar from Windows but I would like to know in my VB6 app when it ends so I can send emails, etc...

Swi

 

[strongm]

>I would like to know in my VB6 app when it ends

Ah - but sadly the documentation shows this is not (directly) possible:

CopyHere Method
...
Remarks
No notification is given to the calling program to indicate that the copy has completed.

 

[Swi]

Thanks.

So I assume that the only other option would be to use a 3rd party control of some sort?

Thanks again.

Swi

 

[strongm]

Well, the technique you are using (examining the .Count) is a fairly reasonable approach. Why don't you like it?

 

[Swi]

It does not seem to be updating the Status Counter.

It just keeps returning 0 in an endless loop.

Could it be because it is a slow network connection?

Swi

 

[strongm]

>It does not seem to be updating the Status Counter

Hmm. Interesting ... let's see

 

[strongm]

Ah.

Perhaps if you commetn out the On Error, you'll be able to see what is happening. Although, to be honest, I'd have expected an error here as well:

.NameSpace(Template).CopyHere .NameSpace("\\999.999.9.999\c$\MCS\MCS Template").Items

Basically we need to trick NameSpace into interpreting a parameter passed in a string variable correctly, and the cheapest way we can do this is by adding an empty string to it in the call

So:

.NameSpace(Template) => .NameSpace("" & Template)

 

[Swi]

Thanks. I will give it a shot. I had to get it working quickly so I opted for a free 3rd party tool named xStandard.

Swi

 

[dilettante]

Yeah, using Shell operations for this can be a little shabby. They don't work in all contexts anyway so I'm not sure why this is as popular as it seems to be.

Third party solutions are common enough, and you can easily wrap the free InfoZip DLLs as done in

http://www.vbaccelerator.com/home/VB/Code/Libraries/Compression/Zipping_Files/article.asp

 

[strongm]

>They don't work in all contexts anyway

For example?

 

[dilettante]

I've had problems using that approach in programs that run in a non-interactive Service context. This might be a program started by Scheduler at system start, a program that is a Service itself, or a program running as a CGI handler under a Web server. For all I know it also fails when used in a DLL invoked by Classic ASP pages or as the result of an MSMQ Trigger, Console programs run via Telnet or SSH sessions, etc.

CopyHere() and friends tend to fail in these kinds of scenarios generally. I suppose they're only one step removed from using SendKeys and the like.

Ideally Microsoft would have exposed the capability more directly.

Considering how many free alternatives are available I'm not sure it makes sense to get into the habit of taking a dependency on an interactive Desktop. Many of them provide cleaner "progress" feedback, offer a "cancel" capability, etc.

 

[strongm]

><Service context

Well hang on, that's moving the goalposts somewhat. The shell functions were written for use in an interactive process, for example:

CopyHere
Applies to: desktop apps only

so to argue that the reason not to use them is that they don't always work properly if you use them in an environment they are documented not to work in is surely somewhat disingenuous. Furthermore, the same argument would suggest that we not use any shell32 functions where there is a 3rd party library available that provides similar functionality.

I'd contend that if a library does what is needed in the environment it is supposed to work in, then there is no reason not to use it.

Of course if people need more zipping functionality than exposed by the shell functions (such a better visibility of progress) then yes alternatives are available, and may be preferable (although in most cases you then lose the ability to simply treat the zip file and it's contents as a folder).

 

[dilettante]

Well I'm not sure how that is "moving goalposts." VB6 is VB6, no matter what Project type you are using. I was simply adding a caveat people seldom mention. Another is the lack of support pre-XP though that one is fading quickly in the rear-view mirror.