当 windowStyle=0 不够时，如何在 VBA 中使用 .Run 时隐藏所有窗口

Question

在 VBA 中使用 .Run 启动 .exe 时，典型的调用可能如下所示：

x = wsh.Run(Command:="program.exe ""argument""", WindowStyle:=0, waitonreturn:=False)

理论上哪里windowStyle=0应该导致程序运行对用户不可见。但是，如果 .exe 中出现您不希望用户看到的弹出窗口，该怎么办？

windowStyle 输入不会抑制警告消息或弹出窗口的出现，声明诸如“计算完成”之类的内容向用户显示，这通常也会暂停代码，直到清除弹出窗口。以自动方式清除窗口（即单击“确定”）是微不足道的（请参阅此答案），但事实证明，作为一个相对初学者，阻止它一开始就出现在用户面前是很困难的。（即当弹出窗口由.exe触发时，它对用户来说是不可见的，然后由VBA代码自动关闭）

目前我使用此函数检测是否存在新的弹出窗口（其中 sCaption 是弹出窗口的名称）：

Private Function GetHandleFromPartialCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean

Dim lhWndP As Long
Dim sStr As String
GetHandleFromPartialCaption = False
lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
Do While lhWndP <> 0
    sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
    GetWindowText lhWndP, sStr, Len(sStr)
    sStr = Left$(sStr, Len(sStr) - 1)
    If InStr(1, sStr, sCaption) > 0 Then
        GetHandleFromPartialCaption = True
        lWnd = lhWndP
        Exit Do
    End If
    lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
    Loop
End Function

然后自动关闭。但它仍然会在屏幕上短暂地向用户闪烁。理想情况下，我希望此 VBA 代码在后台运行，以便用户可以在运行时继续执行其他任务，而不会被闪烁的框分散注意力。

有没有办法强制program.exe的所有窗口（包括弹出窗口）在运行时不可见？

有关更多信息，请参阅我之前关于如何关闭弹出窗口的问题，此处。该线程涉及如何防止其出现在用户面前。

编辑1

SendKeys 是喜怒无常的，所以当我检测到弹出窗口时，我使用这个循环代码来杀死 .exe，因此 .exe 不需要处于焦点状态来关闭弹出窗口（关闭弹出窗口会杀死 .exe）无论如何我的情况）：

....
Main Code Body
....
    t = Now
    waittime = Now + TimeValue("0:01:30") 'limit to run a single row of calculations 
    Do While t < waittime
        If GetHandleFromPartialCaption(lhWndP, "Popup Window Text") = True Then
               Set oServ = GetObject("winmgmts:")
               Set cProc = oServ.ExecQuery("Select * from Win32_Process")
                  For Each oProc In cProc
                      If oProc.Name = "Program.exe" Then 
                         errReturnCode = oProc.Terminate() 
                         Marker2 = 1
                         Exit Do
                      End If
                  Next
        Endif
    Loop
....
Main Code Body Continues
....

其中GetHandleFromPartialCaption()是上面的函数，根据 sCaption 参数查找弹出窗口。我的代码在 .exe 运行计算时不断循环并搜索弹出窗口，并在 .exe 出现后立即将其杀死。但它仍然向用户闪烁。

Answer 1

要运行完全隐藏的应用程序，请在不同的桌面上使用CreateProcess.

这是执行简单命令行并等待进程退出的示例：

Option Explicit

Private Declare PtrSafe Function OpenDesktop Lib "user32.dll" Alias "OpenDesktopW" (ByVal lpszDesktop As LongPtr, ByVal dwFlags As Long, ByVal fInherit As Byte, ByVal dwDesiredAccess As Long) As LongPtr
Private Declare PtrSafe Function CreateDesktop Lib "user32.dll" Alias "CreateDesktopW" (ByVal lpszDesktop As LongPtr, ByVal lpszDevice As LongPtr, ByVal pDevmode As LongPtr, ByVal dwFlags As Long, ByVal dwDesiredAccess As Long, ByVal lpsa As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseDesktop Lib "user32.dll" (ByVal hDesktop As LongPtr) As Long
Private Declare PtrSafe Function CreateProcess Lib "kernel32.dll" Alias "CreateProcessW" (ByVal lpApplicationName As LongPtr, ByVal lpCommandLine As LongPtr, ByVal lpProcessAttributes As LongPtr, ByVal lpThreadAttributes As LongPtr, ByVal bInheritHandles As Byte, ByVal dwCreationFlags As Long, ByVal lpEnvironment As LongPtr, ByVal lpCurrentDirectory As LongPtr, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As LongPtr, ByVal dwMilliseconds As Long) As Long
Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As LongPtr, ByRef lpExitCode As Long) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32.dll" Alias "GetWindowTextW" (ByVal hwnd As LongPtr, ByVal lpString As LongPtr, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function EnumDesktopWindows Lib "user32.dll" (ByVal hDesktop As LongPtr, ByVal lpfn As LongPtr, ByRef lParam As Any) As Long
Private Declare PtrSafe Function SendMessageW Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetLastError Lib "kernel32.dll" () As Long

Private Type STARTUPINFO
  cb                  As Long
  lpReserved          As LongPtr
  lpDesktop           As LongPtr
  lpTitle             As LongPtr
  dwX                 As Long
  dwY                 As Long
  dwXSize             As Long
  dwYSize             As Long
  dwXCountChars       As Long
  dwYCountChars       As Long
  dwFillAttribute     As Long
  dwFlags             As Long
  wShowWindow         As Integer
  cbReserved2         As Integer
  lpReserved2         As LongPtr
  hStdInput           As LongPtr
  hStdOutput          As LongPtr
  hStdError           As LongPtr
End Type

Private Type PROCESS_INFORMATION
  hProcess            As LongPtr
  hThread             As LongPtr
  dwProcessID         As Long
  dwThreadID          As Long
End Type


Public Sub UsageExample()
  Dim exitCode As Long
  exitCode = ExecuteHidden("cmd /C echo abcd > %USERPROFILE%\Desktop\output.txt", timeoutMs:=10000)
End Sub

Public Function ExecuteHidden(command As String, timeoutMs As Long) As Long
  Dim si As STARTUPINFO, pi As PROCESS_INFORMATION, hDesktop As LongPtr, ex As Long
  Const NORMAL_PRIORITY_CLASS& = &H20&, INFINITE& = &HFFFFFFFF, GENERIC_ALL& = &H10000000

  On Error GoTo Catch

  ' get a virtual desktop '
  si.lpDesktop = StrPtr("hidden-desktop")
  hDesktop = OpenDesktop(si.lpDesktop, 0, 0, GENERIC_ALL)
  If hDesktop Then Else hDesktop = CreateDesktop(si.lpDesktop, 0, 0, 0, GENERIC_ALL, 0)
  If hDesktop Then Else Err.Raise GetLastError()

  ' run the command '
  si.cb = LenB(si)
  If CreateProcess(0, StrPtr(command), 0, 0, 1, NORMAL_PRIORITY_CLASS, 0, 0, si, pi) Then Else Err.Raise GetLastError()

  ' wait for exit '
  If WaitForSingleObject(pi.hProcess, timeoutMs) Then Err.Raise 1000, , "Timeout while waiting for the process to exit"
  If GetExitCodeProcess(pi.hProcess, ExecuteHidden) <> 0 Then Else Err.Raise GetLastError()

  ' cleanup '
Catch:
  If pi.hThread Then CloseHandle pi.hThread
  If pi.hProcess Then CloseHandle pi.hProcess
  If hDesktop Then CloseDesktop hDesktop
  If Err.Number Then Err.Raise Err.Number
End Function

如果您需要在桌面上查找窗口，请EnumDesktopWindows使用EnumWindows：

Private Function FindWindow(ByVal hDesktop As LongPtr, title As String) As LongPtr
  Dim hwnds As New Collection, hwnd, buffer$
  buffer = Space$(1024)

  EnumDesktopWindows hDesktop, AddressOf EnumDesktopWindowsProc, hwnds

  For Each hwnd In hwnds
    If Left$(buffer, GetWindowText(hwnd, StrPtr(buffer), Len(buffer))) Like title Then
      FindWindow = hwnd
      Exit Function
    End If
  Next
End Function

Private Function EnumDesktopWindowsProc(ByVal hwnd As LongPtr, hwnds As Collection) As Long
  hwnds.Add hwnd
  EnumDesktopWindowsProc = True
End Function

如果您需要关闭窗口，只需发送WM_CLOSE到主窗口或弹出窗口：

const WM_CLOSE& = &H10&
SendMessageW hwnd, WM_CLOSE, 0, 0