Zipping File Code (1 Viewer)

Eljefegeneo

Still trying to learn
Local time
Today, 00:38
Joined
Jan 10, 2011
Messages
904
There is a popup showing the compressing of a file when executing the standard Zipping File code that displays when the file is zipping. How do I suppress the pop-up? I believe it is in the following line of code:
Code:
 ' Wait for compression to complete before exiting
Do While oShl.AppActivate("Compressing...") = True
 

theDBguy

I’m here to help
Staff member
Local time
Today, 00:38
Joined
Oct 29, 2018
Messages
21,358
Hi. Can you maybe post the entire code?
 

Eljefegeneo

Still trying to learn
Local time
Today, 00:38
Joined
Jan 10, 2011
Messages
904
This is the code:
Code:
Public Sub Zip(ZipFile As String, InputFile As String)
On Error GoTo ErrHandler
Dim FSO As Object 'Scripting.FileSystemObject
Dim oApp As Object 'Shell32.Shell
Dim oFld As Object 'Shell32.Folder
Dim oShl As Object 'WScript.Shell
Dim i As Long
Dim l As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(ZipFile) Then
'Create empty ZIP file
FSO.CreateTextFile(ZipFile, True).Write _
"PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
End If
Set oApp = CreateObject("Shell.Application")
Set oFld = oApp.NameSpace(CVar(ZipFile))
i = oFld.Items.Count
oFld.CopyHere (InputFile)
Set oShl = CreateObject("WScript.Shell")
'Search for a Compressing dialog
Do While oShl.AppActivate("Compressing...") = False
If oFld.Items.Count > i Then
'There's a file in the zip file now, but
'compressing may not be done just yet
Exit Do
End If
If l > 30 Then
'3 seconds has elapsed and no Compressing dialog
'The zip may have completed too quickly so exiting
Exit Do
End If
DoEvents
Sleep 100
l = l + 1
Loop
' Wait for compression to complete before exiting
Do While oShl.AppActivate("Compressing...") = True
DoEvents
Sleep 100
Loop
ExitProc:
On Error Resume Next
Set FSO = Nothing
Set oFld = Nothing
Set oApp = Nothing
Set oShl = Nothing
Exit Sub
ErrHandler:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & _
": " & Err.Description, _
vbCritical, "Unexpected error"
End Select
Resume ExitProc
Resume
End Sub
 

theDBguy

I’m here to help
Staff member
Local time
Today, 00:38
Joined
Oct 29, 2018
Messages
21,358
This is the code:
Code:
Public Sub Zip(ZipFile As String, InputFile As String)
On Error GoTo ErrHandler
Dim FSO As Object 'Scripting.FileSystemObject
Dim oApp As Object 'Shell32.Shell
Dim oFld As Object 'Shell32.Folder
Dim oShl As Object 'WScript.Shell
Dim i As Long
Dim l As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(ZipFile) Then
'Create empty ZIP file
FSO.CreateTextFile(ZipFile, True).Write _
"PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
End If
Set oApp = CreateObject("Shell.Application")
Set oFld = oApp.NameSpace(CVar(ZipFile))
i = oFld.Items.Count
oFld.CopyHere (InputFile)
Set oShl = CreateObject("WScript.Shell")
'Search for a Compressing dialog
Do While oShl.AppActivate("Compressing...") = False
If oFld.Items.Count > i Then
'There's a file in the zip file now, but
'compressing may not be done just yet
Exit Do
End If
If l > 30 Then
'3 seconds has elapsed and no Compressing dialog
'The zip may have completed too quickly so exiting
Exit Do
End If
DoEvents
Sleep 100
l = l + 1
Loop
' Wait for compression to complete before exiting
Do While oShl.AppActivate("Compressing...") = True
DoEvents
Sleep 100
Loop
ExitProc:
On Error Resume Next
Set FSO = Nothing
Set oFld = Nothing
Set oApp = Nothing
Set oShl = Nothing
Exit Sub
ErrHandler:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & _
": " & Err.Description, _
vbCritical, "Unexpected error"
End Select
Resume ExitProc
Resume
End Sub
Okay, thanks. I am just guessing, but I think the popup message maybe a byproduct of this line:
oFld.CopyHere (InputFile)

This line, I think, is merely checking if the popup warning is still showing, so it knows when the operation has completed.
Do While oShl.AppActivate("Compressing...") = True
 

Eljefegeneo

Still trying to learn
Local time
Today, 00:38
Joined
Jan 10, 2011
Messages
904
So, is here a way of supressing it? Or do I just have to live with it?
 

Users who are viewing this thread

Top Bottom