Prev: How to clear a text file
Next: VB6 service under Server 2008 can't run another VB application
From: Woodie Morris on 19 Jun 2010 21:11
I'm using the info zip dlls and I'm having trouble stopping a zip operation
in progress. I've figured out (I think) that I need to call the cancel event
in my cancel button's click event which I do with:
Private Sub cmdCancel_Click()
m_cZip.Service "", True
End Sub

Then in the zip's cancel method I have the following:
Private Sub m_cZip_Cancel(ByVal sMsg As String, bCancel As Boolean)
If bCancel Then
If MsgBox("Are you sure? Cancel the folder backup?", vbYesNo, "Confirm
cancel") = vbYes Then
' Code to stop the zip operation here

Set m_cZip = Nothing
Unload Me
End If
End If
End Sub

Trouble is even after setting the zip object to nothing and unloading the
form the zip operation still continues in the background until my "Zip
operation complete" messagebox comes up. Here's the code I'm using to zip
the files (a sub in the same form that's referenced as "Me" above):

Public Sub BackupDataAndGraphicsFolders(CallingForm As Form)
' Folders to backup are: DefaultDataFolder and GetNewDefaultGraphicsPath
Dim SelectedFolder As String, ZipSuccess As Boolean
SelectedFolder = GetBrowseDirectory(CallingForm.hwnd, "Select the location
to create the folder backup and click 'Ok'", GetMyComputerFolder)
If Trim(SelectedFolder) <> "" Then ' "" = Canceled
If FSO.FileExists(SelectedFolder & "WHDataFolderBackup.Zip") Or
FSO.FileExists(SelectedFolder & "WHGraphicsFolderBackup.Zip") Then
If MsgBox("A folder backup file already exists at that location. Do
you want to overwrite it?", vbYesNo, "Overwrite backup at this location?") =
vbNo Then GoTo Skip
If FSO.FileExists(SelectedFolder & "WHDataFolderBackup.Zip") Then
Kill (SelectedFolder & "WHDataFolderBackup.Zip")
If FSO.FileExists(SelectedFolder & "WHGraphicsFolderBackup.Zip")
Then Kill (SelectedFolder & "WHGraphicsFolderBackup.Zip")
End If
' Create zip object
Set m_cZip = New cZip
With m_cZip
.Encrypt = False
' Put up 'This may take a few minutes' message
Screen.MousePointer = vbHourglass
Me.Caption = "Backing up data and graphics folders"
CallingForm.Refresh
DoEvents
Err.Clear
On Error Resume Next
' Create the data folder zip file
.ZipFile = SelectedFolder & "WHDataFolderBackup.Zip"
.ClearFileSpecs
.RecurseSubDirs = True
.StoreFolderNames = True
.BasePath = DefaultDataFolder
' Add the data folder files
.AddFileSpec "*.*"
lblPrompt.Caption = "This may take a long time depending on how much
data and graphics you have and where they are being copied from/to." &
vbCrLf & vbCrLf & "Backing up data folder, please wait..."
Me.Show vbNormal, CallingForm
Me.Refresh
DoEvents
' Zip the files
.Zip
' Create the graphics folder zip file
.ZipFile = SelectedFolder & "WHGraphicsFolderBackup.Zip"
.ClearFileSpecs
.RecurseSubDirs = True
.StoreFolderNames = True
.BasePath = GetNewDefaultGraphicsPath
' Add the graphics folder files
.AddFileSpec "*.*"
' Prepare progress bar
lblPrompt.Caption = "This may take a long time depending on how much
data and graphics you have and where they are being copied from/to." &
vbCrLf & vbCrLf & "Backing up graphics folder, please wait..."
DoEvents
' Zip the files
.Zip
ZipSuccess = .Success
End With
' Clean up
Set m_cZip = Nothing
Screen.MousePointer = vbNormal
If ZipSuccess And Err.Description = "" Then
MsgBox "Data and graphics folders succesfully backed up to: " &
SelectedFolder & "WHDataFolderBackup.Zip and " & SelectedFolder &
"WHGraphicsFolderBackup.Zip", vbInformation
Else
MsgBox "An error occured in the folder backup process. Make sure the
destination drive has enough free space and try again."
End If
Unload Me
End If

Skip:
Unload Me
End Sub

BTW, no need to lecture me on not using the File System Object. The FSO...
references above are using an FSO class I created that replaces all my old
file system object calls.

Thanks -Woodie



 | 
Pages: 1
Prev: How to clear a text file
Next: VB6 service under Server 2008 can't run another VB application