yu2n

Const strWindowTitle = "Notepad++"   ' 监控的窗口标题

Do
  Main
  WScript.Sleep 2000
Loop

Sub Main()
 
  Dim wso, fso
  Set wso = CreateObject("Wscript.Shell")
  Set fso=CreateObject("Scripting.FileSystemObject")
  
  '检查是否重复运行
  If AppPrevInstance() = True Then
    Msgbox "该程序不允许重复运行！" & vbCrLf & String(75," "), vbOKOnly+vbCritical, WScript.ScriptName
    '直接退出程序
    WScript.Quit(2)
  End If
  
  '一直检查窗口，直到指定窗口出现
  Do While wso.AppActivate(strWindowTitle) = False
    WScript.sleep 200    ' 延时 0.2 秒
  Loop
  
  '激活窗口
  Call WindowActive(strWindowTitle)
  
  '关闭窗口(发送 Alt + F4)
  wso.SendKeys "(%{F4})"
  
  '打开我的电脑
  wso.Run "Explorer.exe /n," 

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


'一直检查窗口，直到指定窗口出现
Sub MonitorWindowTitle(ByVal strWindowTitle)
  Dim wso : Set wso = CreateObject("Wscript.Shell")
  Do While wso.AppActivate(strWindowTitle) = False
    WScript.sleep 200    ' 延时 0.2 秒
  Loop
  Set wso = NoThing
End Sub

'激活窗口
Sub WindowActive(ByVal strWindowTitle)
  Dim objWord, objTasks
  Set objWord = CreateObject("word.Application") 
  Set objTasks = objWord.Tasks
  If objTasks.Exists(strWindowTitle) Then
    objTasks(strWindowTitle).Activate         '激活窗口
    objTasks(strWindowTitle).WindowState = 0  '0平常模式、1最大化模式、2最小化模式
  End If 
  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

版本2，更改了一些逻辑。

Const strWindowTitle = "Notepad++"   ' 监控的窗口标题

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 秒
    '检查是否重复运行
    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
复制代码