DoWhile Loop Stuck while using colMonitoredevents

Question

I am using a script to monitor a folder for addition of files. The script runs fine if 3 files (meeting the conditions) are added to the monitored folder. It nicely extracts the data from these files and adds to the open excel file. But if the conditions are not me the script keeps going through the Do While Loop and I am unable to use any buttons on the excel (Was thinking of using another command button to exit the loop). Please Help!! Any suggestions are appreciated! Thanks!

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

Here is how you can stop the looping (but I really wish you would answer the question of what should happen if all three files are NOT present - exit? Wait?)

Place the following at the form level (i.e. at the top of the module - outside of all subroutines):

Dim fvStopTheLoop              As Boolean

Inside the Sub cmdStart_Click, insert the following:

fvStopLoop = False

After EACH of your 'Do While True' statements, add the following line:

DoEvents

Where you have 'If i = 3 then', replace like the following:

    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

Add a new command button with the following code:

Private Sub cmdStop_Click()
    fvStopLoop = True
End Sub