How can I ensure my application retains focus while SendKeys is called? (Is there a better way than using Sleep?)

Question

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?

Answer 1

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

Answer 2

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
'================