Reputation: 1298
I am updating some scripts which need to switch focus to an application, send some keystrokes, before returning focus to another application.
Option Explicit
dim objShell
set objShell = WScript.CreateObject("WScript.Shell")
objShell.AppActivate "AnApplication"
WScript.Sleep 1000
objShell.SendKeys("%{I}")
...
objShell.SendKeys("{END}")
WScript.Sleep 1000
objShell.AppActivate "AnotherApplication"
Set objShell = Nothing
I researched some improvements to make to these scripts, and one thing I wished to do was to remove the Sleep
statements to speed up the execution of the scripts. In researching this, I found that it's suggested that you check the return value of AppActivate
before continuing, to effectively make the script wait until the application has focus and can be sent keystrokes.
I tried updating my script to do this -
Option Explicit
dim objShell
set objShell = WScript.CreateObject("WScript.Shell")
While Not objShell.AppActivate "AnApplication"
Sleep 300
Wend
objShell.SendKeys("%{I}")
...
objShell.SendKeys("{END}")
While Not objShell.AppActivate "AnotherApplication"
Sleep 300
Wend
However the keystrokes seem to only send after focus has been returned to AnotherApplication.
Is there a way to do this to ensure that AnApplication has focus while the keystrokes are sent, without using Sleep?
Upvotes: 6
Views: 11859
Reputation: 1
This helped me a great deal, but I found that I needed to add a small amount of time to allow the OS to actually put that window into focus, so I added WScript.Sleep 100
between the AppActivate
and SendKeys
lines.
Which worked well enough until I realized that in certain circumstances some of my processes had exited before the script was called, causing my keystrokes to be sent to the wrong window. See, the problem is that Shell.AppActivate
will send the command to activate a program by it's PID, but there's nothing to check to see if that program has exited. So, I added another sub that queried winmgmts for the active PID (as well as the CommandLine since each process is called uniquely).
Here is my contribution, with my deepest thanks:
'================
Sub DelayedSendKeysWithFocusAndProcessCheck(str, procid, cmdline)
Call ProcCheck(procid, cmdline)
Shell.AppActivate procid
WScript.Sleep 100
Shell.SendKeys str
End Sub
'================
Sub ProcCheck(procid, cmdline)
CheckedPID = ""
CheckedCmdLine = ""
Set ProcessCollection = GetObject("winmgmts:\\" & ComputerName & "\roo" &_
"t\cimv2")
Set ProcessResults = ProcessCollection.ExecQuery(" Select * from Win32_Pr" &_
"ocess where ProcessID = '" & procid & "'")
For Each obj in ProcessResults
CheckedPID = obj.ProcessID
CheckedCmdLine = obj.CommandLine
Next
If CheckedPID <> procid Then
Shell.Popup "PID " & procid & " (" & cmdline & ") appears to have exite" &_
"d!", 0, "Called Process is Missing!", vbOkOnly
Call EndScript
Else
Call RegExSearch(cmdline, CheckedCmdLine)
If ReturnValue(0) <> "" Then
Shell.Popup "The PID " & procid & " no longer shows the same command " &_
"line I started it with!" & vbcrlf & "When I started it, it used " & vbcrlf &_
cmdline & vbcrlf & "Now it shows " & CheckedCmdLine & "I'm going to exit no" &_
"w. You can try to run me again or simply open the windows manually." & vbcrlf &_
"(Please note that this is an incredibly rare error and you should probabl" &_
"y buy a lottery ticket.)", 0, "Called process command line has changed!", vbOkOnly
Call EndScript
End If
End If
End Sub
'================
Upvotes: 0
Reputation: 16311
As I mentioned in my comment, there's no need to put AppActivate()
in a loop. It's a synchronous call and the function shouldn't return until it's activated the window (or failed trying).
If you're concerned about your window losing focus, you can call AppActivate()
again after sending a few keystrokes or you can call it before every set of keystrokes.
For example:
If Not MySendKeys("AnApplication", "%{I}") Then MsgBox "Could not send %{I}"
If Not MySendKeys("AnApplication", "{End}") Then MsgBox "Could not send {End}"
Function MySendKeys(strApp, strKeys)
If objShell.AppActivate(strApp) Then
objShell.SendKeys strKeys
MySendKeys = True
End If
End Function
Upvotes: 4