[英]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?专门使用 Excel 2016,有没有办法处理在宏过程中启动的 MS Windows 提示?
Edit: I'm unable to use 7zip or WinZip command line as they are not available in the environment.编辑:我无法使用 7zip 或 WinZip 命令行,因为它们在环境中不可用。 I have access to VBScript, and VBA exclusively.
我可以独占访问 VBScript 和 VBA。 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.
我发现的其他研究表明 Windows Shell 不支持解压缩受密码保护的文件,因此我试图通过处理 Windows 提示而不是直接处理 zip 文件来解决这个问题。
I have a routine that opens zip files, below, which is being used on password protected zip files.我有一个例程可以打开下面的 zip 个文件,该例程用于受密码保护的 zip 个文件。 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.
function 可以让用户有机会在键盘上输入密码,但我希望提高自动化程度。
The passwords are deterministic, but I need to handle two different potential windows that can launch as the application runs.密码是确定性的,但我需要处理两个不同的潜在 windows,它们可以在应用程序运行时启动。
Is there a Windows API Excel can connect to to handle these two scenarios, or is there another way for Excel to manage windows?是否有 Windows API Excel 可以连接到处理这两种情况,或者 Excel 是否有另一种方式来管理 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
To let VBA handle the dialog prompt, you'll have to run the Shell command in a different way.要让 VBA 处理对话框提示,您必须以不同的方式运行 Shell 命令。 When you run Shell command from a Shell object, VBA will wait for the object to return before resuming the execution of the code.
当您从 Shell object 运行 Shell 命令时,VBA 将等待 object 返回,然后再继续执行代码。
What we need here is to launch the Shell command and let VBA continue afterwards.我们这里需要的是启动 Shell 命令,然后让 VBA 继续。 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.由于
CopyHere
方法在这里不容易访问,我们将不得不使用批处理文件来运行我们需要的代码。 So, take the following code inspired by this answer , paste it to your favorite text editor and save it as "unzip.bat".因此,将受此答案启发的以下代码粘贴到您最喜欢的文本编辑器中,并将其另存为“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:然后,假设您有 Excel 2010 或更高版本,您的 VBA 解压缩存档的过程将如下所示:
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:笔记:
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.