使用colMonitoredevents时DoWhile循环卡住

Question

我正在使用脚本来监视添加文件的文件夹。如果将3个文件（满足条件）添加到受监控的文件夹，脚本运行良好。它很好地从这些文件中提取数据并添加到打开的excel文件中。但如果条件不是我的脚本继续通过Do While Loop，我无法使用Excel中的任何按钮（正在考虑使用另一个命令按钮退出循环）。请帮忙！！任何建议表示赞赏！谢谢！

Public vItem As Variant 
'vItem contains the folder path that the user selects. 
'Another function deals with this and only its values is passed to `CommandButton2 Click()` 

Private Sub CommandButton2_Click() 
Dim i As Integer 
    i = 0 
Dim fcounter, pcounter, vcounter As Integer 
    fcounter = 0 
    pcounter = 0 
    vcounter = 0 



Set objShell = CreateObject("Wscript.Shell") 

strComputer = "." 

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") 

Dim vItemstr As String 
vItemstr = Replace(vItem, "\", "\\\\") 
MsgBox vItemstr 



Set colMonitoredEvents = objWMIService.ExecNotificationQuery _ 
    ("SELECT * FROM __InstanceCreationEvent WITHIN 10 WHERE " _ 
     & "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _ 
      & "TargetInstance.GroupComponent= " _ 
       & "'Win32_Directory.Name=" & Chr(34) & vItemstr & Chr(34) & "'") 



Do While True 

    Set objLatestEvent = colMonitoredEvents.NextEvent 
    StrNewfile = objLatestEvent.TargetInstance.PartComponent 


    arrNewFile = Split(StrNewfile, "=") 
    strFileName = arrNewFile(1) 
    strFileName = Replace(strFileName, "\\", "\") 
    strFileName = Replace(strFileName, Chr(34), "") 
     Dim justfilename, namestr As String 
      justfilename = Dir(strFileName) 
      Do While True 
        novaval = InStr(1, justfilename, "SampleResults") 

          If novaval > 0 Then 
            namestr = "f" 
            Exit Do 
          End If 
        novaval = InStr(1, justfilename, "v") 
          If novaval > 0 Then 
            namestr = "v" 
            Exit Do 
          End If 
        novaval = InStr(1, justfilename, "p") 
          If novaval > 0 Then 
            namestr = "p" 
            Exit Do 
          End If 
      Loop 

     If namestr = "f" And fcounter = 0 Then 
      i = i + 1 

      Dim OpenFileName As String 
      Dim wb As Workbook 

       Set wb = Workbooks.Open(strFileName, UpdateLinks:=0) 
        ThisWorkbook.Sheets(1).Range("K18:P18").Value = wb.Sheets(1).Range("G1:L1").Value 
        ThisWorkbook.Sheets(1).Range("K19:P19").Value = wb.Sheets(1).Range("G5:L5").Value 
        ThisWorkbook.Sheets(1).Range("K20:P20").Value = wb.Sheets(1).Range("G4:L4").Value 
        ThisWorkbook.Sheets(1).Range("K21:P21").Value = wb.Sheets(1).Range("G3:L3").Value 
        ThisWorkbook.Sheets(1).Range("K22:P22").Value = wb.Sheets(1).Range("G2:L2").Value 
        ThisWorkbook.Save 
       wb.Close 
      fcounter = fcounter + 1 
     ElseIf namestr = "v" And vcounter = 0 Then 
       i = i + 1 
       Set wb = Workbooks.Open(strFileName, UpdateLinks:=0) 
        ThisWorkbook.Sheets(1).Range("C18:E18").Value = wb.Sheets(1).Range("C1:E1").Value 
        ThisWorkbook.Sheets(1).Range("C19:E19").Value = wb.Sheets(1).Range("C5:E5").Value 
        ThisWorkbook.Sheets(1).Range("C20:E20").Value = wb.Sheets(1).Range("C4:E4").Value 
        ThisWorkbook.Save 
       wb.Close 
      vcounter = vcounter + 1 
     ElseIf namestr = "p" And pcounter = 0 Then 
       i = i + 1 
       Set wb = Workbooks.Open(strFileName, UpdateLinks:=0) 
        ThisWorkbook.Sheets(1).Range("F18:H18").Value = wb.Sheets(1).Range("X1:Z1").Value 
        ThisWorkbook.Sheets(1).Range("F19:H19").Value = wb.Sheets(1).Range("X5:Z5").Value 
        ThisWorkbook.Sheets(1).Range("F20:H20").Value = wb.Sheets(1).Range("X4:Z4").Value 
        ThisWorkbook.Save 
       wb.Close 
      pcounter = pcounter + 1 

     End If 


     If i = 3 Then 
      Exit Do 
     End If 


Loop 

End Sub 

Answer 1

这里是你如何能停止循环（但我真的希望你能回答的，如果所有的三个文件不存在应发生什么问题？ - 出口等待？）

发生在以下形式水平（即，在模块的顶部 - 所有子程序的外部）：

Dim fvStopTheLoop    As Boolean 

小组cmdStart_Click内部，插入如下：

fvStopLoop = False 

各处理之后你'做，当真正的陈述，添加以下行：

DoEvents 

如果你有“如果我= 3，那么”，取代类似如下：

If i = 3 Then 
     Exit Do 
    End If 
    If fvStopLoop = True Then 
     MsgBox "Ending the loop due to user request", vbOKOnly, "End" 
     Exit Sub 
    End If 

添加一个带有以下代码的新命令按钮：

Private Sub cmdStop_Click() 
    fvStopLoop = True 
End Sub