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

Question

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

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

每天我们都会生成一些文件然后运行宏。它每天都在同一个文件中出错;也就是说它不是完全相同的文件，而是每天使用不同版本的相同报告。它是最大的文件，但除此之外没有任何突出的文件。

还有两个奇怪之处：

1. 当使用F8逐步运行代码时，错误不会发生 - 这意味着我无法确切地指出错误的位置;
2. 代码有一个跳过错误文件的选项 - 当跳过并立即再次重新运行时，没有其他更改，第二次不会发生错误。

这是代码;宏被称为不同的时间，不同的位置作为参数：

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

Answer 1

我建议在程序之外但在同一代码模块中插入现有代码下面的子代码。

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之后引入等待。