在VBA中使用.Run启动.exe时,典型的调用可能如下所示:
x = wsh.Run(Command:="program.exe ""argument""", WindowStyle:=0, waitonreturn:=False)
其中windowStyle=0
理论上应该导致程序对用户不可见。但是,如果在.exe中出现一个您不希望用户看到的弹出窗口怎么办?
windowStyle输入不会抑制警告消息的出现或弹出窗口,声明“计算完成”之类的内容不会出现给用户,这通常还会暂停代码,直到弹出窗口被清除。以自动方式清除窗口(即点击'okay')是微不足道的(参见this answer),但是作为相对初学者,对我来说防止它出现在用户身上是很困难的。 (即当弹出由.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的所有窗口,包括弹出窗口,在运行时是不可见的?
有关详细信息,请参阅我之前关于如何关闭弹出窗口here的问题。该主题涉及如何防止其出现给用户。
编辑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。但它仍然闪现在用户身上。
要运行完全隐藏的应用程序,请使用desktop在不同的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
简短的回答是隐藏弹出窗口,它需要调用ShowOwnedPopups(hwnd,0)。这里给出了VBA声明
Declare Function ShowOwnedPopups Lib "user32" Alias "ShowOwnedPopups" _
(ByVal hwnd As Long, ByVal fShow As Long) As Long
对于一些实验性的C#代码进行更长时间的回答,请查看此blog post。为简洁起见,我将博客文章的第一部分复制到了答案中。
首先,一个关键的读取资源是Windows Features,它告诉所有窗口都是用CreateWindowEx创建的,但弹出窗口是通过指定WS_POPUP创建的,子窗口是通过指定WS_CHILD创建的。所以弹出窗口和子窗口是不同的。
在Window Visibility部分的同一页面上,它解释了我们可以设置主窗口的可见性,并且更改将级联到所有子窗口,但没有提到这个影响弹出窗口的级联。
这里有一些最终的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)中也没有任何东西看起来会有所帮助,没有什么可以指定弹出窗口的可见性。
怎么样:
Dim TaskID as Double
TaskID = Shell("program.exe", vbHide)
或者如果窗口的行为不符合要求,请尝试使用vbNormalNoFocus
或vbMinimizedNoFocus
。
如果由于某种原因这不合适,请分享一些关于.exe的更多信息...也许重定向输出可能是一个选项。
我假设您无法修改“program.exe”以使用其他类型的通知?
#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