Question

我目前正在VBA中编写一个程序，它将导入数据，解析并将其导出为CSV。一切都很好，但我想添加一个功能，允许用户按下代码中间的按钮，在下一个文件后停止它。

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

这就是我所拥有的。当用户启动程序时，它开始检查文件。然而，与此同时，它切换到一个新的工作表，其上有一个标记为“停止”的按钮，因此，假设它将在当前文件完成后停止程序。但是，当我点击按钮并等待时，似乎没有任何事情发生 - 它只是从来没有认出来。

这是我需要解决的问题 - 如何在无限循环周期中有一个停止/暂停程序的按钮？它只是在空文件夹状态下跳过代码时工作得很好，但是一旦它开始解析文件就不能识别按下按钮。有没有办法使用UserForms甚至表单按钮？如果是这样，解决问题的最佳方法是什么？

我目前的代码：

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

使用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作为“Schedule”参数告诉OnTime()方法取消与前两个参数匹配的已调度子例程调用。这一行也可以写成：

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

Answer 2

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

循环期间如何使用按钮作为开关（VBA）

2 个答案: