在调用SendKeys时，如何确保应用程序保持焦点?(有比使用睡眠更好的方法吗?)

Question

我正在更新一些脚本，这些脚本需要将焦点切换到一个应用程序，发送一些按键，然后再将焦点返回到另一个应用。

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

我研究了对这些脚本的一些改进，我希望做的一件事是删除Sleep语句以加快脚本的执行。在研究这一点时，我发现建议您在继续之前检查AppActivate的返回值，以有效地使脚本等待应用程序有焦点并可以发送按键。

我尝试更新我的脚本来做到这一点-

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 

然而，按键似乎只在焦点返回到AnotherApplication之后才发送。

有没有一种方法可以做到这一点，以确保AnApplication在发送按键时具有焦点，而不使用睡眠？

Answer 1

正如我在评论中提到的，没有必要将AppActivate()放入循环中。这是一个同步调用，函数在激活窗口(或尝试失败(之前不应该返回。

如果您担心窗口失去焦点，您可以在发送几次键击后再次调用AppActivate()，也可以在每次键击之前调用它。

例如：

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

这对我帮助很大，但我发现我需要添加少量时间才能让操作系统真正聚焦该窗口，所以我在AppActivate和SendKeys行之间添加了WScript.Sleep 100。

它运行得很好，直到我意识到在某些情况下，我的一些进程在调用脚本之前已经退出，导致我的击键被发送到错误的窗口。看，问题是Shell.AppActivate会通过PID发送激活程序的命令，但没有什么可检查的，看该程序是否已退出。因此，我添加了另一个子例程，它查询winmgmts中的活动PID(以及CommandLine，因为每个进程都是唯一调用的(。

以下是我的贡献，并致以最深切的感谢：

'================
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" &_
  "tcimv2")
  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
'================