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

Question

When launching an .exe using .Run in VBA, a typical call may look like this:

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

Where windowStyle=0 should theoretically cause the program to run invisible to the user. But what if a pop-up window occurs within the .exe that you don't want to the user to see?

The windowStyle input will not suppress the appearance of warning messages or pop up windows declaring things like 'calculation complete' from appearing to the user, this often also pauses the code until the pop up is cleared. Clearing the window (i.e. clicking 'okay') in an automated manner is trivial (see this answer), but preventing it from appearing to the user to begin with is proving difficult to me as a relative beginner. (i.e. when the pop up is triggered by the .exe it is invisible to the user, and then closed automatically by the VBA code)

Currently I detect the existence of a new pop up window using this function (where sCaption is the name of the pop up 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

Then close it automatically. But it still briefly flashes up on screen to the user. Ideally I'd like this VBA code to run in the background so the user can get on with other tasks whilst it runs, not being distracted by flashing boxes.

Is there a way to force all windows of program.exe, including pop ups, to be invisible whilst it is running?

For further information, see my previous question on how to close the pop up window, here. This thread concerns how to prevent its appearance to a user.

EDIT 1

SendKeys is temperamental, so I am using this looping code to kill the .exe when I detect the pop up window, therefore the .exe does not need to be in focus to close the pop up (closing the pop up kills the .exe in my case anyway):

....
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
....

where GetHandleFromPartialCaption() is the function above, finding the pop up window based on the sCaption argument. My code loops and searches constantly for the pop up whilst the .exe is running the calculation, and kills the .exe as soon as it appears. But it still flashes up to the user.

Answer 1

To run an application completely hidden, launch it in a different desktop with CreateProcess.

Here's an example executing a simple command line and waiting for the process to exit :

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

And if you need to find a window in the desktop, use EnumDesktopWindows instead of 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

If you need to close a window, simply send WM_CLOSE to the main window or to a popup:

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

Answer 2

The short answer is to hide popups it is required to call ShowOwnedPopups(hwnd,0). The VBA declaration is given here

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

For a longer answer with some experimental C# code investigating this see this blog post. I have copied first part of blog post into answer here for brevity.

Firstly, a key reading resource is Windows Features which tells that all windows are created with CreateWindowEx but popups are create by specifying WS_POPUP and child windows are created by specifying WS_CHILD. So popups and child windows are different.

On the same page in the section Window Visibility it explains that we can set the visibility of a main window and the change will cascade down to all child windows but there is no mention of this cascade affecting popups.

And here is some final VBA code but which depends upon a simple C# demo program called VisibilityExperiment

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

To repeat, to hide popups one must call ShowOwnedPopups(). Sadly, I cannot see around this restriction. Even if we tried to use the Windows API directly to spawn the process there is nothing in the STARTUPINFO structure (Windows) which looks like it will help, there is nothing to specify the visibility of popups.

Answer 3

How about:

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

or if the window is not behaving as desired, try vbNormalNoFocus or vbMinimizedNoFocus.

If this isn't suitable for some reason, please share some more about what the .exe ... Perhaps redirected output could be an option.

• More from MSDN.

• Some interesting notes here _{^{(albeit for C#)}}

• Redirecting standard Shell output

I assume you are unable to modify "program.exe" to use a different type of notification?

An alternative approach is to force Excel to stay "on top":

• 3 Best Ways to Force a Window to Stay on Top

• A utility called "Always On Top"

• How to keep Excel Window Always on Top, such as:

#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