Ошибка автоматизации 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.