如何在 VBA 中使用 .运行时隐藏所有 windows，当 windowStyle=0 不够时

Question

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

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

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

window样式输入不会抑制警告消息的出现或弹出 windows 声明诸如 'calculation complete' 之类的东西不会出现在用户面前，这通常也会暂停代码直到弹出窗口被清除。以自动方式清除 window（即单击 'okay'）是微不足道的（参见），但事实证明，作为亲戚，阻止它出现在用户面前是困难的初学者。（即，当弹出窗口由 .exe 触发时，用户不可见，然后由 VBA 代码自动关闭）

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

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 中的所有 windows，包括弹出窗口，在运行ning 时不可见？

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

编辑 1

SendKeys 是喜怒无常的，所以当我检测到弹出窗口时，我使用这个循环代码来杀死 .exe window，因此 .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参数找到弹窗window。我的代码循环并不断搜索弹出窗口，而 .exe 正在计算运行，并在 .exe 出现时立即终止。但它仍然向用户闪烁。

Answer 1

怎么样：

Dim TaskID as Double
TaskID = Shell("program.exe", vbHide)

或如果 window 未按预期运行，请尝试 vbNormalNoFocus 或 vbMinimizedNoFocus.

如果由于某种原因这不适合，请分享更多关于 .exe 的内容...也许重定向输出是一个选项。

来自 MSDN 的更多内容。
一些有趣的笔记here_{^{（尽管是C#）}}
Redirecting standard Shell output

我假设您无法修改 "program.exe" 以使用不同类型的通知？

另一种方法是强制Excel留下来"on top":

3 Best Ways to Force a Window to Stay on Top
名为 "Always On Top"
How to keep Excel Window Always on Top，如：

#If Win64 Then

    Public Declare PtrSafe Function SetWindowPos _
        Lib "user32" ( _
            ByVal hwnd As LongPtr, _
            ByVal hwndInsertAfter As LongPtr, _
            ByVal x As Long, ByVal y As Long, _
            ByVal cx As Long, ByVal cy As Long, _
            ByVal wFlags As Long) _
    As Long

#Else

    Public Declare Function SetWindowPos _
        Lib "user32" ( _
            ByVal hwnd As Long, _
            ByVal hwndInsertAfter As Long, _
            ByVal x As Long, ByVal y As Long, _
            ByVal cx As Long, ByVal cy As Long, _
            ByVal wFlags As Long) _
    As Long
#End If

Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2

Sub ShowXLOnTop(ByVal OnTop As Boolean)
    Dim xStype As Long
    #If Win64 Then
        Dim xHwnd As LongPtr
    #Else
        Dim xHwnd As Long
    #End If
    If OnTop Then
        xStype = HWND_TOPMOST
    Else
        xStype = HWND_NOTOPMOST
    End If
    Call SetWindowPos(Application.hwnd, xStype, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Sub

Sub SetXLOnTop()
    ShowXLOnTop True
End Sub

Sub SetXLNormal()
    ShowXLOnTop False
End Sub

Answer 2

简短的回答是隐藏需要调用 ShowOwnedPopups(hwnd,0) 的弹出窗口。 VBA声明在这里给出

Declare Function ShowOwnedPopups Lib "user32" Alias "ShowOwnedPopups" _
   (ByVal hwnd As Long, ByVal fShow As Long) As Long

如需使用一些研究此问题的实验性 C# 代码获得更长的答案，请参阅此 blog post。为了简洁起见，我已将博客 post 的第一部分复制到这里的答案中。

首先，一个关键的阅读资源是Windows Features which tells that all windows are created with CreateWindowEx，但是弹出窗口是通过指定WS_POPUP创建的，子windows是通过指定WS_CHILD创建的。所以弹出窗口和子窗口 windows 是不同的。

在 Window Visibility 部分的同一页上，它解释了我们可以设置主 window 的可见性，并且更改将级联到所有子 windows 但是有没有提到影响弹出窗口的级联。

这里是一些最终的 VBA 代码，但它依赖于一个名为 VisibilityExperiment

的简单 C# 演示程序

Option Explicit

Private Declare Function ShowOwnedPopups Lib _
    "user32" (ByVal hwnd As Long, _
    ByVal fShow As Long) As Long

Private Declare Function EnumWindows _
    Lib "user32" ( _
        ByVal lpEnumFunc As Long, _
        ByVal lParam As Long) _
        As Long

Private Declare Function GetWindowThreadProcessId _
    Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long



Private mlPid As Long
Private mlHWnd As Variant


Private Function EnumAllWindows(ByVal hwnd As Long, ByVal lParam As Long) As Long

    Dim plProcID As Long
    GetWindowThreadProcessId hwnd, plProcID
    If plProcID = mlPid Then
        If IsEmpty(mlHWnd) Then
            mlHWnd = hwnd
            Debug.Print "HWnd:&" & Hex$(mlHWnd) & "  PID:&" & Hex$(mlPid) & "(" & mlPid & ")"
        End If
    End If

    EnumAllWindows = True
End Function

Private Function GetPID(ByVal sExe As String) As Long

    Static oServ As Object
    If oServ Is Nothing Then Set oServ = GetObject("winmgmts:\.\root\cimv2")

    Dim cProc As Object
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")

    Dim oProc As Object
    For Each oProc In cProc
        If oProc.Name = sExe Then
            Dim lPid As Long
            GetPID = oProc.ProcessID
        End If
    Next

End Function


Private Sub Test()

    Dim wsh As IWshRuntimeLibrary.WshShell
    Set wsh = New IWshRuntimeLibrary.WshShell

    Dim lWinStyle As WshWindowStyle
    lWinStyle = WshNormalFocus

    Dim sExe As String
    sExe = "VisibilityExperiment.exe"

    Dim sExeFullPath As String
    sExeFullPath = Environ$("USERPROFILE") & "\source\repos\VisibilityExperiment\VisibilityExperiment\bin\Debug\" & sExe

    Dim x As Long
    x = wsh.Run(sExeFullPath, lWinStyle, False)

    mlPid = GetPID(sExe)

    mlHWnd = Empty
    Call EnumWindows(AddressOf EnumAllWindows, 0)


    Stop
    Call ShowOwnedPopups(mlHWnd, 0)  '* o to hide, 1 to show

End Sub

重复一遍，要隐藏弹出窗口，必须调用 ShowOwnedPopups()。可悲的是，我看不到这个限制。即使我们尝试直接使用 Windows API 来生成进程，STARTUPINFO structure (Windows) 中也没有任何内容看起来会有帮助，也没有任何内容可以指定弹出窗口的可见性。

Answer 3

要运行完全隐藏的应用程序，请在不同的 desktop with 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

如果您需要在桌面上找到一个 window，请使用 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

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

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

如何在 VBA 中使用 .运行时隐藏所有 windows，当 windowStyle=0 不够时

How to hide all windows when using .Run in VBA, when windowStyle=0 is not sufficient

excel

hidden

vba

window-style

另一种方法是强制Excel留下来"on top":

如何在 VBA 中使用 .运行 时隐藏所有 windows，当 windowStyle=0 不够时

How to hide all windows when using .Run in VBA, when windowStyle=0 is not sufficient

excel

hidden

vba

window-style

另一种方法是强制Excel留下来"on top":

如何在 VBA 中使用 .运行时隐藏所有 windows，当 windowStyle=0 不够时