В чем проблема с моим утилизационным кодом excel VBA?

---

Всем Привет. Я пытаюсь слом данных с веб-сайта в файл excel.
Идея маршрута здесь.

Строки из startrow в stoprow.

Т. е. ориентироваться на сайте, что ссылку можно получить из ячейки в Excell.
Сбор информации и сохранении в Excel.
Следующий

Проблема в том, что я могу запускать только около 30 строк каждый раз, а затем IE crash или IE busy, и мне приходится останавливаться и перезапускать вручную.

Пожалуйста помочь.

Что я уже пробовал:

Sub UpdateProjectListV2(startRow As Long, StopRow As Long)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Dim BaseWorkbook As Workbook
    Set BaseWorkbook = ThisWorkbook
    Dim FuncUpdateBid, FuncPStatus, FuncProCountry, FuncProBudget, sDate1 As String
    Dim DeleteP As Object
    Dim NumbidElem As IHTMLElement
    Dim i, iTotalRows As Long
    Dim stemp As String
    iTotalRows = BaseWorkbook.Worksheets("Project Info").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count
    sDate1 = Format(Now(), "mmm dd,yyyy")
    Dim appIE As InternetExplorer
    Set appIE = CreateObject("internetexplorer.application")
            For i = startRow To StopRow
                With appIE
                    .navigate BaseWorkbook.Worksheets("Project Info").Cells(i, 11).Value
                    .Visible = True
                    '.Visible = False
                End With
                Do Until (appIE.READYSTATE = 4 And Not appIE.Busy)
                    DoEvents ' DoEvents releases the macro and lets excel do other thing while it waits
                Loop
                If BaseWorkbook.Worksheets("Project Info").Cells(i, 4).Value = 1 Then   'No need to update the complete project
                    If (InStr(BaseWorkbook.Worksheets("Project Info").Cells(i, 11).Value, "https://www.freelancer.com/contest/") <> 0) Then
                        BaseWorkbook.Worksheets("Project Info").Cells(i, 4).Value = "Contest"
                    Else
                        If appIE.document.getElementsByClassName("alert-block").Length <> 0 Then    'Project have been delete
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 3).Value = sDate1
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 4).Value = 0
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 6).Value = "Project Deleted"
                        Else
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 3).Value = sDate1
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 6).Value = appIE.document.getElementById("project_status").innerText
                                    If BaseWorkbook.Worksheets("Project Info").Cells(i, 9).Value = "" Then 'Get Çountry
                                        BaseWorkbook.Worksheets("Project Info").Cells(i, 9).Value = appIE.document.getElementsByClassName("user-flag user-icons")(0).getElementsByTagName("img")(0).getAttribute("title")
                                    End If
                                    If BaseWorkbook.Worksheets("Project Info").Cells(i, 10).Value = "" Then   'Get Project budget
                                        BaseWorkbook.Worksheets("Project Info").Cells(i, 10).Value = appIE.document.getElementsByClassName("project-budget")(0).innerText
                                    End If
                                    If BaseWorkbook.Worksheets("Project Info").Cells(i, 1).Value = "" Then  'Get Project ID
                                        BaseWorkbook.Worksheets("Project Info").Cells(i, 1).Value = appIE.document.getElementsByClassName("ProjectReport")(0).getElementsByClassName("normal")(0).innerText
                                    End If
                                        If IsObject(appIE.document.getElementById("num-bids")) Then  'Some private project don't have bid
                                            BaseWorkbook.Worksheets("Project Info").Cells(i, 8).Value = appIE.document.getElementById("num-bids").innerText
                                        Else
                                            BaseWorkbook.Worksheets("Project Info").Cells(i, 8).Value = 0
                                        End If
                        End If
                    End If
                End If
                BaseWorkbook.Worksheets("Dashboard").Cells(8, 6).Value = i
            Next i
    appIE.Quit
    Set appIE = Nothing
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox ("Complete")
End Sub

---