VBA Do Until循环有时会失败

Question

我正在写一些非常基本的Excel VBA宏，用于在工作表上分割和合并大型工作簿。我已经基本解决了这个问题，但是我有一个断断续续发生的故障(大约每10次发生一次)，我似乎无法可靠地再现，更不用说修复了。

在我感兴趣的文件夹中有205个左右的单张工作簿，宏使用Dir()循环遍历它们，当它到达空文件名时结束。但有时它不会。

它偶尔会在浏览这些文件的随机点停下来。我曾经在60-190个导入之间看到过这种情况，它只是在那个点停止执行，没有任何错误或警告。Do Until循环之后的其余代码不执行。

有人遇到类似的东西吗?这是一个内存问题在excel?我都快疯了。在循环中添加计时器来减慢它的速度并没有帮助。在我要合并的文件夹中没有打开的文件。抑制合并过程中弹出的警报不是问题。

下面是循环的代码:

    strFilename = Dir(myPath & "*.xlsx", vbNormal)
    If Len(strFilename) = 0 Then Exit Sub
    Do Until strFilename = ""
        Set wbSrc = Workbooks.Open(fileName:=myPath & "" & strFilename, UpdateLinks:=False)
        Set wsSrc = wbSrc.Worksheets(1)
        wsSrc.Copy after:=wbDst.Worksheets(wbDst.Worksheets.Count)
        wbSrc.Close False
        strFilename = Dir()
    Loop

Answer 1

非常感谢Rory对shift键提示的评论(当然还有所有其他帮助)。没有使用Shift键运行的宏，但偶尔当我使用alt选项卡时，我会使用alt-shift-tab或使用Shift的其他组合，并且由于Excel的"打开时不使用Shift"安全规则而打破它。

微软支持页面上的文档对这个问题有一个解决方案，包括检测何时保持shift键并在Do Until中运行另一个循环，防止open被调用，直到它被释放。

最终相关代码:

'Declare API
Declare Function GetKeyState Lib "User32" _
(ByVal vKey As Integer) As Integer
Const SHIFT_KEY = 16
Function ShiftPressed() As Boolean
'Returns True if shift key is pressed
    ShiftPressed = GetKeyState(SHIFT_KEY) < 0
End Function
...
    Do Until strFilename = ""
        Do While ShiftPressed()
            DoEvents
        Loop
        Set wbSrc = Workbooks.Open(fileName:=myPath & "" & strFilename, UpdateLinks:=False)
        Set wsSrc = wbSrc.Worksheets(1)
        wsSrc.Copy after:=wbDst.Worksheets(wbDst.Worksheets.Count)
        wbSrc.Close False
        strFilename = Dir()
    Loop