[问题求助] [已解决]vbs代码，如果双击多次，运行了多次。就可能出现错误。如何避免？

ygqiang

vbs代码，如果双击多次，运行了多次。就可能出现错误。如何避免？
保证双击多次vbs，也只运行1次。

可以在vbs代码前面，加入个检测功能：
1、如果存在c:\tt.tt文件，就直接退出。
2、如果不存在，就建立c:\tt.tt文件，并执行后面的vbs代码

Do
  JK
Loop
 
'一直检查窗口标题
Sub JK()
  Dim wso,strTitle
  strTitle = "Microsoft Windows"
  Set wso = CreateObject("Wscript.Shell")
 
  ' 一直检查窗口标题
  Do While wso.AppActivate(strTitle) = False
    WScript.sleep 200    ' 延时 0.2 秒
    Call guan()
  Loop
 
  WScript.Sleep 500       ' 延时 0.5 秒
  Call cunz()
  wso.SendKeys "(%{F4})"   ' 发送 Alt + F4
  wso.Run "Explorer.exe /n," '打开我的电脑
  WScript.Sleep 500       ' 延时 0.5 秒
  Call guan()
  Set wso = NoThing
End Sub
 
 
'关闭重复窗口
Sub guan()
    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
 
 
'激活窗口
Sub cunz()
    set wshell = CreateObject("word.Application") 
    set wshellw = wshell.tasks
    na="Microsoft Windows"
    If wshellw.Exists(na) Then
       wshellw(na).Activate         '激活窗口
       wshellw(na).WindowState = 0  '0平常模式、1最大化模式、2最小化模式
    End If 
End SubCOPY

9zhmke

我总感觉应该简单化一点，直接查阅运行程序列表，如果是调用VBS的两个程序名，则查它的参数，看是否与本程序重名，如果重名则退出。

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 FunctionCOPY

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 FunctionCOPY