[问题求助] [已解决]vbs代码如何循环监测指定窗口是否出现并模拟按下alt+f4组合键。

ygqiang

[已解决]vbs代码，实现下面的功能？循环监测，发现某个窗口名，就按下alt+f4组合键。
一直间隔2-3秒，循环监测。如果发现"Microsoft Windows（窗口标题名）"，
就按下alt+f4组合键，关闭这个窗口。然后继续监测。


6楼是初步解决方案。但偶尔会遇到问题。

zhangop9

循环监测指定窗

CrLf

批也可以，但是...

for /l %%a in () do taskkill /fi "windowtitle eq Microsoft Windows（窗口标题名）"
复制代码

9zhmke

我在调用VBS对窗体的激活时，总是发现偶有莫或其妙的不能激活，不知各位有遇到没有？

ygqiang

最终代码。

'关闭重复窗口-u盘监控并弹出我的电脑
Const strWindowTitle = "Microsoft Windows"   ' 监控的窗口标题

Do
  Main
  WScript.Sleep 2000
Loop

Sub Main()
On Error Resume Next
  Dim wso, fso
  Set wso = CreateObject("WScript.Shell")
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  '监控并激活窗口
  Call MonitorWindowTitle(strWindowTitle)
  
  '关闭窗口(发送 Alt + F4)
  wso.SendKeys "(%{F4})"
  
  '打开我的电脑
  wso.Run "Explorer.exe /n," 

  '关闭重复的文件窗口
  Call CloseRepeatFolderWindow()
  
  Set wso = NoThing
  
End Sub

'监控并激活窗口
Sub MonitorWindowTitle(ByVal strWindowTitle)
On Error Resume Next
  Dim wso, objWord, objTasks
  Set wso = CreateObject("Wscript.Shell")
  Set objWord = CreateObject("word.Application")
  Set objTasks = objWord.Tasks
  Do While objTasks.Exists(strWindowTitle) = False
    WScript.sleep 200    ' 延时 0.2 秒
    Call CloseRepeatFolderWindow()
    '检查是否重复运行
    If AppPrevInstance() = True Then
      Call wso.Popup("该程序不允许重复运行！" & vbCrLf & String(75," ") & _
          vbCrLf & "程序将在 3 秒后全部退出 ...", 3, WScript.ScriptName, vbOKOnly+vbCritical)
      '直接退出程序
      objWord.Quit
      WScript.Quit(2)
    End If
  Loop
  Call wso.AppActivate(strWindowTitle)      '激活窗口
  objTasks(strWindowTitle).Activate         '激活窗口
  objTasks(strWindowTitle).WindowState = 0  '0平常模式、1最大化模式、2最小化模式
  objWord.Quit
End Sub

' VBS关闭重复的文件夹窗口 By Crlf bathome.net
Sub CloseRepeatFolderWindow()
  On Error Resume Next
  Dim Shell, Dict, Wins
  Set Shell = CreateObject("Shell.Application")
  Set Dict = CreateObject("Scripting.Dictionary")
  Set Wins = Shell.Windows
  For i=Wins.Count-1 To 0 step -1
    If Instr(LCase(Wins(i).FullName),"\explorer.exe") Then
      If Dict.Exists(Wins(i).LocationURL) Then
        Wins(i).Quit
      Else
        Dict.Add Wins(i).LocationURL,True
      End If
    End If
  Next
End Sub

'检测是否重复运行
Function AppPrevInstance()
  AppPrevInstance=False
  Dim objItem, i
  For Each objItem in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
    IF LCase(objItem.Name)=LCase(Right(WScript.FullName,11)) Then
      IF InStr(1,objItem.CommandLine,WScript.ScriptFullName,vbTextCompare) > 0 Then i=i+1
    End IF
  Next
  If i>1 Then AppPrevInstance=True
End Function
复制代码

yu2n

忽略错误使用：

On Error Resume Next
复制代码

参考：
on error resume next用法
http://www.cnblogs.com/fyen/archive/2011/07/08/2100586.html

ygqiang

又遇见了。

ygqiang

yu2n 发表于 2015-1-4 12:55

win7 64系统，用了下面的vbs代码。偶尔会遇到问题，会弹出窗口提示。然后就不能监控了。

'关闭重复窗口-u盘弹出窗口
Const strWindowTitle = "Microsoft Windows"   ' 监控的窗口标题

Do
  Main
  WScript.Sleep 2000
Loop

Sub Main()

  Dim wso, fso
  Set wso = CreateObject("WScript.Shell")
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  '监控并激活窗口
  Call MonitorWindowTitle(strWindowTitle)
  
  '关闭窗口(发送 Alt + F4)
  wso.SendKeys "(%{F4})"
  
  '打开我的电脑
  wso.Run "Explorer.exe /n," 

  '关闭重复的文件窗口
  Call CloseRepeatFolderWindow()
  
  Set wso = NoThing
  
End Sub

'监控并激活窗口
Sub MonitorWindowTitle(ByVal strWindowTitle)
  Dim wso, objWord, objTasks
  Set wso = CreateObject("Wscript.Shell")
  Set objWord = CreateObject("word.Application")
  Set objTasks = objWord.Tasks
  Do While objTasks.Exists(strWindowTitle) = False
    WScript.sleep 200    ' 延时 0.2 秒
    Call CloseRepeatFolderWindow()
    '检查是否重复运行
    If AppPrevInstance() = True Then
      Call wso.Popup("该程序不允许重复运行！" & vbCrLf & String(75," ") & _
          vbCrLf & "程序将在 3 秒后全部退出 ...", 3, WScript.ScriptName, vbOKOnly+vbCritical)
      '直接退出程序
      objWord.Quit
     WScript.Quit(2)
    End If
  Loop
  Call wso.AppActivate(strWindowTitle)      '激活窗口
  objTasks(strWindowTitle).Activate         '激活窗口
  objTasks(strWindowTitle).WindowState = 0  '0平常模式、1最大化模式、2最小化模式
  objWord.Quit
End Sub

' VBS关闭重复的文件夹窗口 By Crlf bathome.net
Sub CloseRepeatFolderWindow()
  On Error Resume Next
  Dim Shell, Dict, Wins
  Set Shell = CreateObject("Shell.Application")
  Set Dict = CreateObject("Scripting.Dictionary")
  Set Wins = Shell.Windows
  For i=Wins.Count-1 To 0 step -1
    If Instr(LCase(Wins(i).FullName),"\explorer.exe") Then
      If Dict.Exists(Wins(i).LocationURL) Then
        Wins(i).Quit
      Else
        Dict.Add Wins(i).LocationURL,True
      End If
    End If
  Next
End Sub

'检测是否重复运行
Function AppPrevInstance()
  AppPrevInstance=False
  Dim objItem, i
  For Each objItem in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
    IF LCase(objItem.Name)=LCase(Right(WScript.FullName,11)) Then
      IF InStr(1,objItem.CommandLine,WScript.ScriptFullName,vbTextCompare) > 0 Then i=i+1
    End IF
  Next
  If i>1 Then AppPrevInstance=True
End Function
复制代码

yu2n

Do
  JK
Loop

Sub JK()
  Dim wso,strTitle
  strTitle = "Microsoft Windows"
  Set wso = CreateObject("Wscript.Shell")
  ' 一直检查窗口标题
  Do While wso.AppActivate(strTitle) = False
    WScript.sleep 1000    ' 延时 1 秒
  Loop
  WScript.Sleep 2000       ' 延时 2 秒
  wso.SendKeys "(%{F4})"   ' 发送 Alt + F4
  wso.Run "Explorer.exe /n," '打开我的电脑
  Set wso = NoThing
End Sub
复制代码

ygqiang

yu2n 发表于 2015-1-4 12:16

    多谢。。。

set wshell=createobject("wscript.shell")

Do
    WScript.Sleep 2000
    Call guan()
    '2秒调用一次
wshell.appactivate "Microsoft Windows"
wshell.SendKeys "(%{F4})"

Loop 

Sub guan()


do While wshell.AppActivate("Microsoft Windows") = False
    wscript.sleep 1000
loop

End Sub
复制代码

如何下面的代码，合并下？实现alt+f4关闭以后，打开我的电脑。

Set WshShell=WScript.CreateObject("WScript.Shell")
WshShell.SendKeys"额"
复制代码

tmplinshi

去下载一个 AutoHotkey 吧

Loop {
	WinWait, Microsoft Windows（窗口标题名）
	WinClose
}
复制代码

yu2n

Dim wso,strTitle
strTitle = "Microsoft Windows"
Set wso = CreateObject("Wscript.Shell")
' 一直检查窗口标题
Do While wso.AppActivate(strTitle) = False
    WScript.sleep 200    ' 延时 0.2 秒
Loop
WScript.Sleep 3000       ' 延时 3 秒
wso.SendKeys "(%{F4})"   ' 发送 Alt + F4
Set wso = NoThing
复制代码