Excel VBA 自动化错误：调用的对象已与其客户端断开连接——不一致的错误答案

【问题标题】：Excel VBA Automation error: The object invoked has disconnected from its clients -- inconsistent errorExcel VBA 自动化错误：调用的对象已与其客户端断开连接——不一致的错误
【发布时间】：2019-01-11 08:42:59
【问题描述】：

这个错误有很多问题，但似乎没有一个完全符合我的情况，所以发帖希望得到一些帮助。

我有一个宏，它获取一个目录中的所有文件，在一个新的（隐藏的）Excel 实例中静默打开它们，并执行两个“另存为”操作：一个到 SharePoint 上的位置，一个到存档文件夹。这样做的目的是这些文件由 SAS 以 XML 格式生成，并带有 XLS 扩展名。将它们保存为原生 XLSX 会显着减小文件大小。

每天我们都会生成一些文件，然后在这些文件上运行宏。它每天都在同一个文件上出错；也就是说，它不是完全同一个文件，而是每天都有不同版本的同一份报告。它是最大的文件，但除此之外没有什么特别之处。

还有两个奇怪的地方：

使用 F8 逐步运行代码时，不会发生错误 - 这意味着我无法准确定位出错的位置；
代码有一个选项可以跳过出错的文件 - 当跳过并在之后立即重新运行它时，没有其他更改，第二次不会发生错误。

这是代码；宏以不同的位置作为参数在不同的时间被调用：

Sub LoopThroughDirectory(inPath As String, sharepointPath As String, archivePath As String)
    Dim sDir As String
    Dim app As New Excel.Application
    Dim wb As Excel.Workbook
    Dim mbErr As Integer, mbFinished As Integer

    If Right(inPath, 1) <> "\" Then inPath = inPath & "\"

    On Error GoTo ErrHandler:

    sDir = Dir$(inPath, vbNormal)

    Do Until Len(sDir) = 0
        On Error GoTo LoopError:
        app.Visible = False
        app.DisplayAlerts = False
        Set wb = app.Workbooks.Add(inPath & sDir)
        With wb
            .SaveAs Filename:=sharepointPath & Left(.Name, InStrRev(.Name, ".")) & "xlsx", _
                FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, ReadOnlyRecommended:=True
            .SaveAs Filename:=archivePath & Left(.Name, InStrRev(.Name, ".")) & "xlsx", _
                FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close SaveChanges:=False
        End With
        Set wb = Nothing
        app.DisplayAlerts = True
        app.Quit
        Kill (inPath & sDir) ' delete the file

NextFile:
        sDir = Dir$ ' find the next filename
    Loop

    mbFinished = MsgBox( _
        "The process has finished. You may need to review any files that have errored.", _
        vbOKOnly, _
        "Process finished" _
        )

    On Error GoTo 0
    Exit Sub

ErrHandler:
    mbErr = MsgBox( _
        "There has been an error finding files. Check the SharePoint folder and try again.", _
        vbCritical + vbOKOnly, _
        "Error finding files" _
        )
    On Error GoTo 0
    Exit Sub

LoopError:
    Select Case MsgBox("There has been an error with " & sDir & "." & vbCrLf & vbCrLf & _
                        "The error is " & vbCrLf & vbCrLf & _
                        Err.Description & "." & vbCrLf & vbCrLf & _
                        "Press OK to continue with the next file or Cancel to stop the process.", _
                        vbCritical + vbOKCancel, "Error")
        Case vbOK
            Resume NextFile ' go back and try the next file
        Case vbCancel
            On Error GoTo 0
            Exit Sub ' stop processing the files
    End Select

End Sub

【问题讨论】：

您是否尝试过插入一个等待循环，可能是使用 DoEvents 或只是一个直接的 1 秒等待，以允许硬件赶上？删除时间通常比保存时间长。
@Variatus 你能告诉我该怎么做吗？在代码中的哪一点？谢谢。
我的经验是保存/关闭文件和删除文件确实存在时间问题。另一个问题是你从一个Dir枚举中调用Kill，修改了Dir需要枚举的集合，也就是may not be consistent的结果。

标签： excel vba

【解决方案1】：

我建议将 sub 插入到现有代码下方，在您的过程之外但在同一代码模块中。

Private Sub WaitASecond(ByVal Sec As Single)

    Dim WaitTill As Single

    WaitTill = Timer + Sec
    Do
        DoEvents
    Loop While Timer < WaitTill
End Sub

用这样的一行代码从你的主过程中调用它。

WaitASecond(0.5)     ' which would wait for half a second

试验时间长度（如果您愿意，以 0.25 秒为增量）和代码位置。请记住，您最大的文件似乎会产生问题。因此，您可能会限制对该文件的调用或根据文件大小改变等待的长度（如果它对您的流程产生重大影响）。您可以在每个 SaveAs 之后引入等待，仅在 SaveAs 之后和/或 Kill 之后。

【讨论】：