Question

我正在编写一些非常基本的Excel VBA宏来处理在工作表上拆分和合并大型工作簿。我已经把它解决了，但我间歇性地发生了故障（大约10次中有10次），我似乎无法可靠地重现，更不用说修复了。

我感兴趣的文件夹中有205个左右的单片工作簿，宏使用Dir（）循环遍历它们，当它到达空文件名时结束。除了有时它没有。

偶尔会在随机点停止浏览这些文件。我已经看到它发生在60-190之间的导入，它只是停止执行，没有错误或警告。

有没有人碰过类似的东西？这是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键的宏运行，但偶尔我使用alt-tabbed，我使用alt-shift-tab或其他组合使用shift并打破它由于Excel＆＃39;＆＃34 ;打开时没有转变＆＃34;安全规则。

microsoft support页面上的文档解决了这个问题，包括检测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

VBA Do Until循环有时会失败

1 个答案: