I use 'Close_by_Caption' to close open .PDFs before they are regenerated. Previously this was easy because I could assume that always 'Foxit Reader' opened the file and that each file was opened in a separate instance of Foxit.
Newly, 'PDF-XChange Editor' should also be used to open .PDF. Now I don't know if I have to close the file with 'Close_By_Caption 'Demo - PDF-XChange Editor' or 'Demo.pdf - Foxit Reader'.
Of course I can run both commands one after the other - but surely someone will come soon who wants to use another viewer....
Is there a way to find all programs that have the word 'Demo' in 'AppCaption'? Of course, it would be even better if I would knew that either the program is a .PDF-viewer or the opened file is a .PDF...
'API Find application by full caption
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) _
As Long
'*****************************************
'API Bring Window to foreground
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
'*****************************************
'API Send message to application
Private Declare Function PostMessage _
Lib "user32" _
Alias "PostMessageA" _
( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) _
As Long
'*****************************************
Const WM_CLOSE = &H10
'*****************************************
Function Close_By_Caption(AppCaption As String)
Dim hWnd As Long
hWnd = FindWindow(vbNullString, AppCaption)
If hWnd Then
'Bring to Front
SetForegroundWindow hWnd
'Close the app nicely
PostMessage hWnd, WM_CLOSE, 0&, 0&
End If
End Function
'*****************************************
Sub Test_Close()
Close_By_Caption "demo.pdf - Foxit Reader"
End Sub
'*****************************************```
I want to locate an recently opened pdf file and save it in a target folder, right now i can able to locate the pdf file using its name and close it but i want to use Save As function.
Code tried to Locate and close the PDF
Option Explicit
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetWindowThreadProcessId _
Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" (ByVal hwnd As Long, _
ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Const GW_HWNDNEXT = 2
Const WM_CLOSE = &H10
Const SYNCHRONIZE = &H100000
Public Sub Test()
Dim hWindow As Long
Dim hProcess As Long
Dim lProcessId As Long
Dim lngReturnValue As Long
hWindow = SearchHndByWndName_Parent("vieworder.pdf.php")
hProcess = OpenProcess(SYNCHRONIZE, 0&, lProcessId)
lngReturnValue = PostMessage(hWindow, WM_CLOSE, 0&, 0&)
End Sub
Private Function SearchHndByWndName_Parent(strSearch As String) As Long
Dim strTMP As String * 100
Dim nhWnd As Long
nhWnd = FindWindow(vbNullString, vbNullString)
Do While Not nhWnd = 0
If GetParent(nhWnd) = 0 Then
GetWindowText nhWnd, strTMP, 100
If InStr(strTMP, strSearch) > 0 Then
SearchHndByWndName_Parent = nhWnd
Exit Do
End If
End If
nhWnd = GetWindow(nhWnd, GW_HWNDNEXT)
Loop
End Function
I am working in a restricted environment so I cant add any Adobe dll as reference, also the file which i am looking for is not yet saved in any folder.
Please share your suggestions.
Thank You
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.
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
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.
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
Could any one help me to write cell value to new instance of Notepad?
Here is the code I tried:
Sub a()
Dim nt As String
nt = Shell("notepad.exe", vbNormalFocus)
Print #1, ActiveSheet.Cells(1, 1).Value
Close #1
End Sub
I had answered a similar question many years ago in vbforums.com but couldn't find it so I quickly re-wrote it for you. I have commented the code so you shall not have a problem understanding it.
Like you and me, we both have names, similarly windows have “handles” (hWnd), Class etc. Once you know what that hWnd is, it is easier to interact with that window. Findwindow API finds the hWnd of a particular window by using the class name. Read up on the rest of the APIs Here
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SETTEXT = &HC
Private Sub Command1_Click()
Dim Ret As Long, ChildRet As Long
Dim sString As String
'~~> This is the value from the cell which
'~~> you want to send to notepad
sString = Range("A1").Value
'~~> Start Notepad
Ret = Shell("notepad.exe", vbNormalFocus)
'~~> Wait for it to load
DoEvents
'~~> Find notepad
Ret = FindWindow(vbNullString, "Untitled - Notepad")
'~~> Check if found
If Ret = 0 Then
MsgBox "Cannot find Notepad Window"
Exit Sub
End If
'~~> Find the "Edit Window" which is a child window of Notepad window
ChildRet = FindWindowEx(Ret, ByVal 0&, "Edit", vbNullString)
'~~> Send the message
SendMessage ChildRet, WM_SETTEXT, 0, ByVal sString
End Sub
To get the classnames of windows, I usually use Spy ++ or uuSpy. See this is how I got the classname "Edit" of notepad using Spy ++
Using Spy++ I've been trying to control form buttons on an external program with my own program..
The picture shows what control I am attempting to mimic and here's my following code below...
Dim hWnd As IntPtr = FindWindow(vbNullString, ListView4.SelectedItems(0).SubItems(3).Text)
If hWnd.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndButton As IntPtr = _
FindWindowEx(hWnd, IntPtr.Zero, "Button", "Load Settings")
If hWndButton.Equals(IntPtr.Zero) Then
Return
End If
However nothing happens when I run the code.. one possibility is the window name I'm grabbing is wrong, but if that's not the case is my code correct?
Well, as Alex pointed out, I wasn't actually initiating the button press.. now that he pointed that out I was able to fix my code.. Here's what I now use:
Private Declare Auto Function FindWindow Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As IntPtr
Private Declare Auto Function FindWindowEx Lib "user32.dll" ( _
ByVal hwndParent As IntPtr, _
ByVal hwndChildAfter As IntPtr, _
ByVal lpszClass As String, _
ByVal lpszWindow As String _
) As IntPtr
Declare Auto Function SendMessage Lib "user32" (ByVal hwnd As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
Private Const BM_CLICK = &HF5
Dim hwndParent As Long = FindWindow(vbNullString, ListView4.SelectedItems(0).SubItems(3).Text)
Debug.Print("findwindow: " & hwndParent)
Dim hwndButton As Long = FindWindowEx(hwndParent, IntPtr.Zero, "Button", "Save as")
Debug.Print("OK: " & hwndButton)
hwndButton = SendMessage(hwndButton, BM_CLICK, 0, 0)
Debug.Print("Clicked: " & hwndButton)