如何在循环过程中使用按钮作为开关（VBA）

Question

我目前正在VBA中编写一个程序，该程序将导入数据，解析并将其导出为CSV格式。一切工作完全正常，但我试图添加一个功能，允许用户在代码中间按下按钮以在下一个文件后停止它。

我的问题是这样的：我目前有我的程序设置为运行在无限循环检查文件夹解析文件。如果文件夹中有文件，太棒了。如果没有，请跳过该代码。在代码的开头，我有一个DoEvents命令，以防止代码冻结，导致无限循环崩溃。但是，这个命令似乎没有拿起我的按钮在一张纸上按下。

这是我的。当用户开始程序时，它开始检查文件。但是，与此同时，它会切换到一个新的工作表，该工作表上有一个标记为“停止”的按钮，以便在当前文件完成后假设它会停止该程序。但是，当我点击按钮并等待时，似乎没有任何事情发生 - 它只是永远不会识别它。

这是我需要解决的问题 - 我怎样才能有一个按钮，将在无限循环周期内停止/暂停程序？当它在空文件夹状态下跳过代码时，它工作得很好，但只要它开始解析文件，它就无法识别按钮按下。有没有办法使用用户窗体或甚至表单按钮来做到这一点？如果是这样，解决这个问题的最好方法是什么？

我当前的代码：

Sub automaticParsing() 
isActive = True 
Set fs = CreateObject("Scripting.FileSystemObject") 
varSrcPath = ThisWorkbook.Sheets("ControlSheet").Range("B2").Value 
varDestPath = ThisWorkbook.Sheets("ControlSheet").Range("C2").Value 
ThisWorkbook.Sheets("Processing").Buttons("ToggleButton").Caption = "Stop" 
On Error Resume Next 
Sheets("Processing").Visible = True 
Sheets("Processing").Activate 
Sheets("UserMenu").Visible = False 
Sheets("UserMenu2").Visible = False 
On Error GoTo 0 
While isActive = True 
    DoEvents 
    Application.ScreenUpdating = True 
    'Trigger switch - button changes value of this range to "0" 
    If ThisWorkbook.Sheets("ControlSheet").Range("A2").Value = "1" Then 
     varNameOnly = Dir(varSrcPath) 
     varGetFile = varSrcPath & varNameOnly 
     'If the folder is empty, do not run code 
     If varNameOnly = "" Then 
      GoTo skipfile 
     End If 

     'Checks to see if file name had extension 
     varTempBool = False 
     For varTempItgr = 1 To Len(varGetFile) 
      If Mid(varGetFile, varTempItgr, 1) = "." Then 
       varTempBool = True 
      End If 
     Next 
     If varTempBool = False Then varGetFile = varGetFile & "." 
     varFileExtension = Mid(varGetFile, InStrRev(varGetFile, ".")) 

     'If file name didn't have an extension, first argument outputs incorrectly 
     If varTempBool = True Then 
      varTrueNameOnly = Left(varNameOnly, Len(varNameOnly) - Len(varFileExtension)) 
     Else 
      varTrueNameOnly = varNameOnly 
     End If 
     ThisWorkbook.Activate 
     On Error Resume Next 
     Sheets("Processing").Visible = True 
     On Error GoTo 0 
     Sheets("Processing").Select 
     Application.ScreenUpdating = False 
     'Clears tabs 
     Call ClearTabs 
     'Determines file type and runs another giant section of code far too large for this post based on that 
     Call RunMacro 

     If Workbooks("TableBook").Worksheets("test").Range("A" & Workbooks("TableBook").Worksheets("test").Rows.Count).End(xlUp).Row > 59000 Then 
      Call exportTable 
     End If 

     'As long as the file wasn't already moved, move it to the destination path 
     If varAlreadyMoved = False Then 
      Name varGetFile As varDestPath & varNameOnly 
     End If 
     Application.DisplayAlerts = False 

     'Checks to see if any open workbook is correctly named, and if so, deletes it. 
     For varTempItgr = 1 To Workbooks.Count 
      If Workbooks(varTempItgr).Name = varTrueNameOnly & ".CSV" Then 
       Workbooks(varTrueNameOnly).Close 
       Exit For 
      End If 
     Next 
     Application.DisplayAlerts = True 
    Else 
     isActive = False 
    End If 
skipfile: 
    Wend 
ThisWorkbook.Activate 
On Error Resume Next 
Sheets("UserMenu").Visible = True 
Sheets("UserMenu2").Visible = False 
Sheets("Processing").Visible = False 
On Error GoTo 0 
End Sub 

如果您对代码的任何其他问题，我会很高兴地通知你。

Answer 1

听起来像你需要在你的代码中引入多线程。这样，循环可以在每个循环开始时检查布尔值的状态，并且如果它满足条件，它将继续。第二个线程（用于按下按钮）可以改变变量的状态，以便下一次循环到达时，条件不满足，程序停止。

Answer 2

而不是使用无限循环使用Application.OnTime()来安排执行文件夹扫描代码。此示例代码将扫描的文件夹5秒完成最后的“处理”后，如果点击按钮取消操作：

声明全局变量的模块：

Dim bStopProcessing as Boolean 'for cancelling the process 
Dim nextScheduledScanTime as Date 'time at which to call scanFolderForChanges() again 

初始化bStopProcessing并调用scanFolderForChanges()子程序在单独的宏开始整个过程​​：

Sub startScanning() 
    'calling this subroutine will begin continuous scanning 
    bStopProcessing = False 
    scanFolderForChanges 
End Sub 

夹扫描子程序：

Sub scanFolderForChanges() 
    'if [btnStopProcessing] was clicked, stop processing. 
    If bStopProcessing Then Exit Sub 
    '... 
    '<folder scanning and processing code goes here> 
    '... 
    If Not bStopProcessing Then 
     'store the scheduled time so we can cancel it if the workbook is closed 
     nextScheduledScanTime = Now + TimeValue("00:00:05") 
     'schedule the next call to this subroutine (5 seconds from now) 
     Application.OnTime nextScheduledScanTime, "scanFolderForChanges" 
    End If 
End Sub 

在停止按钮的单击事件：

Private Sub btnStopProcessing_Click() 
    bStopProcessing = True 
End Sub 

内Workbook_BeforeClose()事件：

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    'prevent the scheduled procedure from being called after this workbook is closed 
    On Error Resume Next 
    Application.OnTime nextScheduledScanTime, "scanFolderForChanges", , False 
End Sub 

传递False的“时间表”参数告诉OnTime()方法来取消匹配计划的子程序调用前两个参数。这条线也可写成：

Application.OnTime nextScheduledScanTime, "scanFolderForChanges", Schedule:=False