CODEWITHSUNDEEP
excelvba
m_zardos
m_zardos

Reputation: 35

Excel VBA: Handling Windows Prompts within Application

Using Excel 2016 exclusively, is there a way to handle MS Windows prompts which launch during a macro's process?

Edit: I'm unable to use 7zip or WinZip command line as they are not available in the environment. I have access to VBScript, and VBA exclusively. Additional research I found suggested that the Windows Shell does not support unpacking password protected files, so I'm trying to approach this problem by handling the Windows prompts rather than directly handle the zip files.

I have a routine that opens zip files, below, which is being used on password protected zip files. The function works in giving the user the opportunity to enter the password if they're at the keyboard, but I'm looking to increase the automation.

The passwords are deterministic, but I need to handle two different potential windows that can launch as the application runs.

  1. While extracting the zip file, an undetermined error can occur which can only be bypassed by pressing "Skip", which I can then record in an error log for later.
  2. When the application works successfully, a prompt for the password appears and I'd like to pass a value into that text field to remove the necessity of human intervention.

Is there a Windows API Excel can connect to to handle these two scenarios, or is there another way for Excel to manage windows?

Thank you for your time! I greatly appreciate any assistance.

Sub UnzipFile(ByRef s_savePath As String, ByRef s_zipName As String)

    Dim o_shell As Shell
    Dim dbl_i As Double
    Dim dbl_count As Double
    Dim s_file As String

    Set o_shell = CreateObject("Shell.Application")
    dbl_count = o_shell.Namespace(s_zipName).Items.Count

    If dbl_count  > 0 Then
        For dbl_i = 0 To dbl_count - 1
            o_shell.Namespace(s_savePath).CopyHere o_shell.Namespace(s_zipName).Items.Item(dbl_i)
        Next dbl_i
    End If

    Set o_shell = Nothing

End Sub

Upvotes: 2

Views: 429

Answers (1)

DecimalTurn
DecimalTurn

Reputation: 4127

To let VBA handle the dialog prompt, you'll have to run the Shell command in a different way. When you run Shell command from a Shell object, VBA will wait for the object to return before resuming the execution of the code.

What we need here is to launch the Shell command and let VBA continue afterwards. For that we can use:

Shell "My Command", vbNormalFocus

Since the CopyHere method is not easily accessible here, we'll have to use a batch file to run the code we need. So, take the following code inspired by this answer, paste it to your favorite text editor and save it as "unzip.bat".

@echo off
setlocal
cd /d %~dp0
set vbs="%temp%\_.vbs"
if exist %vbs% del /f /q %vbs%
>%vbs%  echo Set fso = CreateObject("Scripting.FileSystemObject")
>>%vbs% echo If NOT fso.FolderExists(%1) Then
>>%vbs% echo fso.CreateFolder(%1)
>>%vbs% echo End If
>>%vbs% echo set objShell = CreateObject("Shell.Application")
>>%vbs% echo set FilesInZip=objShell.NameSpace(%2).items
>>%vbs% echo objShell.NameSpace(%1).CopyHere(FilesInZip)
>>%vbs% echo Set fso = Nothing
>>%vbs% echo Set objShell = Nothing
cscript //nologo %vbs%
if exist %vbs% del /f /q %vbs%
exit /b

Then, assuming you have Excel 2010 or higher, your VBA procedure to unzip the archive would look like this:

Sub UnzipFile(ByRef savePath As String, ByRef zipName As String)

    Dim password As String
    password = "YourPassword"
    
    Dim batchFileName As String
    batchFileName = "C:\YourPath\unzip.bat"
    
    Shell Chr(34) & batchFileName & Chr(34) & " " & Chr(34) & savePath & Chr(34) & " " & Chr(34) & zipName & Chr(34), vbNormalFocus

    Dim hDialog As LongPtr
    Application.Wait Now + TimeValue("00:00:03")
    hDialog = FindWindow("#32770", "Password needed")
    
    If hDialog <> 0 Then
    
        Dim hPasswordBox As LongPtr
        hPasswordBox = FindWindowEx(hDialog, 0, "Edit", vbNullString)
        SendMessage hPasswordBox, WM_SETTEXT, 0, ByVal password
        
        Dim hButton As LongPtr
        hButton = FindWindowEx(hDialog, 0, "Button", "OK")
        Application.Wait Now + TimeValue("00:00:02")
        SendMessage hButton, BM_CLICK, 0, 0
        
    End If
    
End Sub

Also make sure to add the necessary declarations at the top of the module:

'Windows API functions declarations
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

'List of Windows Messages used (in hexadecimal representation):
'For a full list: https://wiki.winehq.org/List_Of_Windows_Messages
Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5

Notes:

  • Wait times are there as an indication only. The required time might vary.

Upvotes: 1

Related Questions