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

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

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

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

windowStyleinput不会抑制警告消息的出现或popup窗口，声明“计算完成”这样的东西显示给用户，这通常也会暂停代码，直到popup窗口被清除。 以自动方式清除窗口（即点击'好'）是微不足道的（见这个答案 ），但防止它出现给用户开始对我来说是困难的作为一个相对的初学者。 （即当popup由.exe触发时，它对用户是不可见的，然后由VBA代码自动closures）

目前我使用这个函数检测到新popup窗口的存在（其中sCaption是popup窗口的名称）：

 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 

然后自动closures它。 但是它仍然在屏幕上短暂闪烁给用户。 理想情况下，我希望这个VBA代码在后台运行，这样用户可以在运行时继续执行其他任务，而不会被闪烁的盒子分心。

有没有办法强制program.exe的所有窗口，包括popup窗口，在运行时是不可见的？

有关更多信息，请参阅我的上一个关于如何closurespopup窗口的问题 。 这个线程涉及如何防止其出现给用户。

编辑1

SendKeys是脾气暴躁的，所以我使用这个循环代码来杀死.exe，当我检测到popup窗口，因此.exe不需要焦点closurespopup（closurespopup杀死.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()是上面的函数，find基于sCaption参数的popup窗口。 我的代码不断循环search，在.exe正在运行计算时popup，并在出现时立即终止.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 

如果你需要在桌面上find一个窗口，使用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 

如果您需要closures窗口，只需将WM_CLOSE发送到主窗口或popup窗口：

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

Answer 2

简短的回答是隐藏需要调用ShowOwnedPopups（hwnd，0）的popup窗口。 VBA声明在这里给出

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

对于一些实验C＃代码调查这个更长的答案看到这篇博客文章 。 为了简洁起见，我在这里复制了博文的第一部分。

首先，一个关键的阅读资源是Windowsfunction ，它告诉所有的窗口都是用CreateWindowEx创build的，但popup窗口是通过指定WS_POPUP创build的，子窗口是通过指定WS_CHILD创build的。 所以popup窗口和子窗口是不同的。

在“ 窗口可见性 ”部分的同一页面上，它解释了我们可以设置主窗口的可见性，更改将级联到所有子窗口，但是没有提及影响popup窗口的级联。

这里有一些最终的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 

要重复，要隐藏popup窗口，必须调用ShowOwnedPopups（）。 可悲的是，我看不到这个限制。 即使我们试图直接使用Windows API来产生进程， STARTUPINFO结构（Windows）中也没有任何东西可以帮助您，但没有什么可以指定popup窗口的可见性。

Answer 3

怎么样：

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

或者如果窗口的行为不符合要求，请尝试vbNormalNoFocus或vbMinimizedNoFocus 。

如果这不适合某种原因，请分享一些关于什么.exe …也许redirect输出可能是一个选项。

• 更多来自MSDN 。

• 这里有一些有趣的注释_{^{（虽然是C＃）}}

• redirect标准的Shell输出

我假设你无法修改“program.exe”来使用不同types的通知？

另一种方法是强制Excel保持“最佳状态” ：

• 三种最好的方式来强制一个窗口留在最上面

• 一个名为“永远在上面”的工具

• 如何保持Excel窗口始终在最前面 ，例如：

#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