Stopping explorer window to open after unzip (1 Viewer)

[mcdhappy80]

I've found this Unzip Module on net and it works perfect. The only thing that bothers me is that after the unzip operation explorer window, where the files are stored, opens. How do I stop the window from opening?
Thank You.

Unzip Module:

Option Compare Database
Option Explicit
Declare Function OpenProcess Lib "kernel32" _
                             (ByVal dwDesiredAccess As Long, _
                              ByVal bInheritHandle As Long, _
                              ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
                                    (ByVal hProcess As Long, _
                                     lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

Public Function ShellAndWait(ByVal PathName As String, Optional WindowState)
    Dim hProg As Long
    Dim hProcess As Long, ExitCode As Long
    'fill in the missing parameter and execute the program
    If IsMissing(WindowState) Then WindowState = 1
    hProg = Shell(PathName, WindowState)
    'hProg is a "process ID under Win32. To get the process handle:
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
    Do
        'populate Exitcode variable
        GetExitCodeProcess hProcess, ExitCode
        DoEvents
    Loop While ExitCode = STILL_ACTIVE
End Function



'With this example you can browse to the zip file you want to unzip
'The zip file will be unzipped in a new folder in: Application.DefaultFilePath
'Normal if you have not change it this will be your Documents folder
'The name of the folder that the code create in this folder is the Date/Time
'You can also use a fixed path like :
'NameUnZipFolder = "C:\Users\Ron\TestFolder\" & Format(Now, "yyyy-mm-dd hh-mm-ss")
'Read the comments in the code about the commands/Switches in the ShellStr
'There is no need to change the code before you test it

Function A_UnZip_Zip_File_Browse(pNameUnzipFolder As String, pFileNameZip As String)
    Dim PathZipProgram As String, NameUnZipFolder As String
    Dim FileNameZip As Variant, ShellStr As String
    Dim Password As String

    'Path of the Zip program
    PathZipProgram = "C:\program files\winzip"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If

    'Check if this is the path where WinZip is installed.
    If dir(PathZipProgram & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Function
    End If

    'Create path and name of the normal folder to unzip the files in
    'In this example we use: Application.DefaultFilePath
    'Normal if you have not change it this will be your Documents folder
    'The name of the folder that the code create in this folder is the Date/Time
    NameUnZipFolder = pNameUnzipFolder
    'NameUnZipFolder = Application.DefaultFilePath & "\" & Format(Now, "yyyy-mm-dd hh-mm-ss")
    
    'NameUnZipFolder = "C:\Program Files\MCDesign\DULane\Racunovodstvo\Razduzivanje\Izvod\Original"

    'You can also use a fixed path like :
    'NameUnZipFolder = "C:\Users\Ron\TestFolder\" & Format(Now, "yyyy-mm-dd hh-mm-ss")

    'Select the zip file (.zip or .zipx files)
    'FileNameZip = Application.GetOpenFilename(filefilter:="Zip Files, *.zip*", _
    '                                         MultiSelect:=False, Title:="Select the file that you want to unzip")
    FileNameZip = pFileNameZip
    'Unzip the files/folders from the zip file in the NameUnZipFolder folder
    If FileNameZip = False Then
        'do nothing
    Else
        'There are a few commands/Switches that you can change in the ShellStr
        'If you add -j it will not keep the folder stucture, add it if you only want the files
        'Use -o if you want to Overwrite existing files without prompting
        ShellStr = PathZipProgram & "Winzip32 -min -e -o" _
                 & " " & Chr(34) & FileNameZip & Chr(34) _
                 & " " & Chr(34) & NameUnZipFolder & Chr(34)

        'Add -s like this -sYourPassWordHere if you want to unzip a file with a password for the files in it
        '        Password = """topsecret"""    'Do not remove the six quotes
        '        ShellStr = PathZipProgram & "Winzip32 -min -e -s" & Password _
                 '                 & " " & Chr(34) & FileNameZip & Chr(34) _
                 '                 & " " & Chr(34) & NameUnZipFolder & Chr(34)

        ShellAndWait ShellStr, vbHide
        
        MsgBox "Fajl kreiran uspesno", vbInformation, "Kreiranje Fajla"
        'MsgBox "Fajl otpakovan u " & NameUnZipFolder, vbInformation, "Kreiranje Fajla"

    End If
End Function

 

[mcdhappy80]

[SOLVED] Stopping explorer window to open after unzip

I've solved the problem with an API function I've found online.
If someone else need it I'll post it on demand.
Thank You

 

[dcb]

Why not just post it here - then the next person that searches for this will have the answer....?

 

[NigelShaw]

Hi,

without giving it too much attention, my first thought is this line

ShellAndWait ShellStr, vbHide

is the line that opens the explorer so by removing it from the main function, the explorer wouldnt open.

i havent tried this though


Nigel

 

[mcdhappy80]

[CODE] Stopping explorer window to open after unzip

Hi,

without giving it too much attention, my first thought is this line

ShellAndWait ShellStr, vbHide

is the line that opens the explorer so by removing it from the main function, the explorer wouldnt open.

i havent tried this though


Nigel

It doesn't work I've tried it. If You omit the second (optional) argument it automatically becomes 1 inside the function and window still opens.

In order to stop this window from closing I've fount two modules online. One is basGetClassnameOfRunningAp, and other is basCloseAnotherApp. Here are the codes for modules:

basGetClassnameOfRunningAp

Option Compare Database
Option Explicit
'************** Code Start ***************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function apiGetClassName Lib "user32" Alias _
                "GetClassNameA" (ByVal Hwnd As Long, _
                ByVal lpClassname As String, _
                ByVal nMaxCount As Long) As Long
Private Declare Function apiGetDesktopWindow Lib "user32" Alias _
                "GetDesktopWindow" () As Long
Private Declare Function apiGetWindow Lib "user32" Alias _
                "GetWindow" (ByVal Hwnd As Long, _
                ByVal wCmd As Long) As Long
Private Declare Function apiGetWindowLong Lib "user32" Alias _
                "GetWindowLongA" (ByVal Hwnd As Long, ByVal _
                nIndex As Long) As Long
Private Declare Function apiGetWindowText Lib "user32" Alias _
                "GetWindowTextA" (ByVal Hwnd As Long, ByVal _
                lpString As String, ByVal aint As Long) As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255

Function fEnumWindows()
Dim lngx As Long, lngLen As Long
Dim lngStyle As Long, strCaption As String
    
    lngx = apiGetDesktopWindow()
    'Return the first child to Desktop
    lngx = apiGetWindow(lngx, mcGWCHILD)
    
    Do While Not lngx = 0
        strCaption = fGetCaption(lngx)
        If Len(strCaption) > 0 Then
            lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
            'enum visible windows only
            If lngStyle And mcWSVISIBLE Then
                Debug.Print "Class = " & fGetClassName(lngx),
                Debug.Print "Caption = " & fGetCaption(lngx)
            End If
        End If
        lngx = apiGetWindow(lngx, mcGWHWNDNEXT)
    Loop
End Function
Private Function fGetClassName(Hwnd As Long) As String
    Dim strBuffer As String
    Dim intCount As Integer
   
    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = apiGetClassName(Hwnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
        fGetClassName = Left$(strBuffer, intCount)
    End If
End Function

Private Function fGetCaption(Hwnd As Long) As String
    Dim strBuffer As String
    Dim intCount As Integer

    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = apiGetWindowText(Hwnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
        fGetCaption = Left$(strBuffer, intCount)
    End If
End Function
'************** Code End ***************

basCloseAnotherApp

Option Compare Database
Option Explicit
'************** Code Start ***************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Const WM_CLOSE = &H10
Private Const INFINITE = &HFFFFFFFF

Private Declare Function apiPostMessage _
    Lib "user32" Alias "PostMessageA" _
    (ByVal Hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long

Private Declare Function apiFindWindow _
    Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassname As String, _
    ByVal lpWindowName As String) _
    As Long
    
Private Declare Function apiWaitForSingleObject _
    Lib "kernel32" Alias "WaitForSingleObject" _
    (ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) _
    As Long
    
Private Declare Function apiIsWindow _
    Lib "user32" Alias "IsWindow" _
    (ByVal Hwnd As Long) _
    As Long
        
Private Declare Function apiGetWindowThreadProcessId _
    Lib "user32" Alias "GetWindowThreadProcessId" _
    (ByVal Hwnd As Long, _
    lpdwProcessID As Long) _
    As Long
        
Function fCloseApp(lpClassname As String) As Boolean
'Usage Examples:
'   To close Calculator:
'       ?fCloseApp("SciCalc")
'
Dim lngRet As Long, Hwnd As Long, pID As Long

    Hwnd = apiFindWindow(lpClassname, vbNullString)
    If (Hwnd) Then
        lngRet = apiPostMessage(Hwnd, WM_CLOSE, 0, ByVal 0&)
        Call apiGetWindowThreadProcessId(Hwnd, pID)
        Call apiWaitForSingleObject(pID, INFINITE)
        fCloseApp = Not (apiIsWindow(Hwnd) = 0)
    End If
End Function
'************* Code End ***************

How does it work? First You open the window (that opens automatically) by yourself (I think the path is what matters here, not sure though), then You run fEnumWindows() function to see the Class Names that are necessary for other function that closes the window (application).
Then, inside my code I've put the following statement:

Do While Not bolClose= True
    bolClose= fCloseApp("CabinetWClass")
Loop

The code is inside the DO WHILE loop because each time there is a different response time when the window opens. This one makes sure that it will close no matter when it opens. For the record, I tried FOR NEXT loop and with it I get Overflow error.
The only problems with the code as is is if You have more than one instance of the window with the same folder path, then the code will close only one instance not all of them, but with little tweaking this can be solved too.

Thank You

 

[dcb]

mcdHappy - Thank you for posting

 

[mcdhappy80]

mcdHappy - Thank you for posting

No prob