Automation error the object invoked has disconnected from its client

[LMacD]

I have searched this site and a number of other sites and found many threads on this error. None seem to come to a very satisfactory solution. I have an excel/vba program that tracks customer service requests for a volunteer group. The Excel program is on a server and used on 3 or 4 PCs all running Windows 10 and Office 2013.

The program will run for weeks without any issues and then I start getting this automation error.

It is hard to debug because the program crashes. The messages comes up and the option to Debug is selected, but it never opens the VBA code at the error. Instead it crashes and closes Excel.

One of our users encountered the problem today and I went to a different PC and open the spreadsheet. When I tried to execute the same action they were trying I got the automation error. When I tried to select debug I got the same result. It crashed.

So I place a Toggle Breakpoint ahead of the problem and executed the same action. But this time the code functioned as expected. There was no error. The only change was I was stepping through the same code on the same data using F8.

This error comes up every 2 or 3 weeks. My frustration level is going through the roof.

I have tried to trap the error using on error goto… But the error is not trapped. I am reasonably sure this is the section of code that the error occasionally fails.

I have considered it could be a memory leak problem but powering down and back up the problem still occurs.
But once I have stepped through the code with F8 the problem is solved and it does not reoccur for a few weeks.

I am at my wits end, any suggestions?

This function is called from a user form to add row 1 to a table. On return the form enters data in table row 1.

[FONT=Verdana]Public Function AddTopRow(p_Table As String, CallingForm As String) As Boolean
    On Error GoTo InsertError
    Select Case p_Table
        Case Is = "tblTasks"
            With lob_tblTasks
                .ListRows.Add 1
                .ListRows(2).Range.Copy
                .ListRows(1).Range.PasteSpecial xlPasteFormats
            End With
            Application.CutCopyMode = False
        
        Case Is = "tblFollowUp"
            With lob_tblFollowUp
                .ListRows.Add 1
                .ListRows(2).Range.Copy
                .ListRows(1).Range.PasteSpecial xlPasteFormats
            End With
            Application.CutCopyMode = False
            
        Case Is = "tblVolunteers"
            With lob_tblVolunteers
                .ListRows.Add 1
                .ListRows(2).Range.Copy
                .ListRows(1).Range.PasteSpecial xlPasteFormats
            End With
            Application.CutCopyMode = False
                
    
        Case Else
            Err.Raise Number:=9000, Description:=" Not a valid table "[/FONT]
[FONT=Verdana]    End Select
    On Error GoTo 0
    AddTopRow = True
    Exit Function
    
InsertError:
    MsgBox "The item you were trying to add encountered an error and was not added" & vbCrLf & _
           "Technical assistance is required to proceed."
    Call Logger("Error - ", p_Table & " Error number " & Err.Number & "  " & Err.Description, CallingForm)
    On Error GoTo -1
    AddTopRow = False
End Function[/FONT]
[FONT=Verdana]'*************************************************************************
'*     Log the error if it occurs                                        *
'*************************************************************************
Sub Logger(sType As String, sDetails As String, sForm)
    Dim p_Date As String
    Dim sFilename As String
    Dim filenumber As Variant
    
    'set file name to the logging text file
    sFilename = Application.ActiveWorkbook.Path & "\logging.txt"
    
    'If it does not exit create it
    If Dir(sFilename) = "" Then
        Call TextFile_Create(sFilename)
    End If
    
    'If it gets too large archive it
    If FileLen(sFilename) > 20000 Then
        FileCopy sFilename _
            , Replace(sFilename, ".txt", Format(Now, "ddmmmyyyy hhmmss.txt"))
        Kill sFilename
    End If
    
    ' Open the file to write
    filenumber = FreeFile
    Open sFilename For Append As #filenumber
    p_Date = CStr(Format(Now, "ddMMMyyyy hh:mm:ss"))
    
    Print #filenumber, p_Date & " , " & sType & " , " & sDetails & " , " & "Form " & sForm & " " & Application.UserName
    
    Close #filenumber
End Sub
[/FONT]