在使用 colMonitoredevents 时执行 While Loop Stuck

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

在 Sub cmdStart_Click 中，插入以下内容：

fvStopLoop = False

在您的每个“Do While True”语句之后，添加以下行：

DoEvents

如果你有 'If i = 3 then'，替换如下：

    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