Ending `Do While` loop with user input for the colMonitoredevents based FOLDER monitoring

[ExcelMind1434]

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 <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 14px; vertical-align: baseline; background-color: rgb(238, 238, 238); font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: pre-wrap; color: rgb(0, 0, 0); line-height: 17.804800033569336px;">Do While Loop</code> and I am unable to use any buttons on the excel (Was thinking of using another command button to exit the loop) to let the user break 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

 

[ExcelMind1434]

Anyone? Please..
Just want to know how to END the monitoring using WMIService.. is there a way to let the user stop the monitoring (like by clicking a button or something?)
Thanks!

 

[Jaafar Tribak]

Have you tried placing a DoEvents statement efter the line : Do While True