Thread: Run-Time Error '-21474417848 (80010108)': Automation Error

Hi guys. First of all, i want to apologize for my bad english. i understand very well, but it is dificult for me to say correct what i want.

I have this error in my Excel file, when i run a macro:

Run-Time Error '-21474417848 (80010108)': Automation Error - The Object invoked has Disconnected from its Clients

I use Microsft excel 2010 with Sp1, x64 version. I have Windows 7 Ultimate. I try my excel file on other system, with x86 default Excel 2010. The same problem.

I will explain in few words what my macro doing:

I extract some data from the internet website, using a link witch my macro open with webquery, and copying the data from internet in same worksheet. Then, do it again, until no more link are.

I will post here the code, maybe you can find were is the problem:

Sub NewLeague()
    
    Application.ScreenUpdating = False
    Dim AnteYear As Worksheet
    
    Application.Run "clear"

    'denumire link nou
    linktext = InputBox(Prompt:="Link name", Title:="LINK", Default:="New link here")
    
    'copiere link in sheetul curent
    Sheets("Season").Range("K2") = linktext
    
    'refresh Results
    With Sheets("WEB").Range("A1").QueryTable
        .Connection = "URL;" & linktext & "results/"
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = True
        .WebDisableRedirections = True
        .Refresh BackgroundQuery:=False
    End With
    
    'copiere results in anul curent
    Set FoundCell = Sheets("WEB").Range("H1:H700").Find(what:="*", after:=Range("H700"), LookIn:=xlValues)
    If Not FoundCell Is Nothing Then
        FirstRow = FoundCell.Row
        Set FoundCell = Sheets("WEB").Range("H1:H700").FindPrevious(after:=FoundCell)
        LastRow = FoundCell.Row
        Sheets("WEB").Range("H" & CStr(FirstRow) & ":L" & CStr(LastRow)).Copy
        Sheets("Season").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    End If

    'sortare meciuri dupa data
    ActiveWorkbook.Worksheets("Season").Sort.SortFields.clear
    ActiveWorkbook.Worksheets("Season").Sort.SortFields.Add Key:=Range("B4:B700"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Season").Sort
        .SetRange Range("B4:F700")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Application.Run "Odds"
    Application.Run "AH"
    Application.Run "Totals"
    Application.Run "UO"
    
    Sheets("Season").Select
    Range("A2").Select
    
    Application.ScreenUpdating = True

End Sub

Here i think is OK.

The all 4 macro witch i calling in this VBA code are practically the same, but the link URL adress is diferent, so i need to create these 4 aditional macro code.

Sub AH()
    Dim AHtext, UOtext, gamelink, linktext As String
    Dim AHlink, UOlink, Oddslink As String
    Dim lastline As Long
    
    Application.ScreenUpdating = False
    
    'copiere link in sheetul curent
    linktext = Sheets("Season").Range("J2")

    'copiere meciuri din results
    lastline = 3 'ultima linie in anul curent
    For Index = 1 To 1000
        AHlink = Sheets("WEB").Range("R1").Offset(Index, 0)
        If AHlink <> "" Then
            AHlink = Sheets("WEB").Range("R1").Offset(Index, 0)
            With Sheets("Asian").Range("A1").QueryTable
                .Connection = "URL;" & AHlink & "/"
                .WebSelectionType = xlEntirePage
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = True
                .WebDisableRedirections = True
                .Refresh BackgroundQuery:=False
            End With
            'copiere meciuri
            Sheets("Asian").Range("N2:U2").Copy
            Sheets("Asian").Range("AA1").Offset(lastline, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            lastline = lastline + 1
        End If
    Next Index
    
    'sortare dupa data
    ActiveWorkbook.Worksheets("Asian").Sort.SortFields.clear
    ActiveWorkbook.Worksheets("Asian").Sort.SortFields.Add Key:=Range("AA4:AA750"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Asian").Sort
        .SetRange Range("AA4:AH750")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Application.ScreenUpdating = True

End Sub

This is one of the 4 macro witch i'm calling.

Now, when the error apear ?

Sometimes, after the first calling macro, sometimes, after the second macro, sometimes after the third macro, sometimes all did well, with no errors.

When my file crashed, i can exit, choose restart or close the Excel file.
When i choose restart, the Debug apear, and the code line

 .Refresh BackgroundQuery:=False

was highlighted with yellow. I think here is the error, but i couldn't find the correct solution.

Thank in advance !

I forgot to mention that, in the second macro witch i posted (AH), the cells from this code

Sheets("Asian").Range("N2:U2").Copy

contains formulas.

Nobody yet ?