Web Veri Çekememe

[askm]

Kolay gelsin.
Office 2010 da çalışan aşağıdaki kodlar 2016 kurulunca hata vermeye çaşladı
Do While .busy: DoEvents: Loop
Do Until .readystate = 4: DoEvents: Loop
Kısmında döngüden çıkamıyor.

Sub HTML_Tara()
Dim ie As Object: Dim eleman: Dim i As Integer: i = 1
On Error Resume Next
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With
Dim YeniSayfa As Worksheet: Set YeniSayfa = Sheets.Add
YeniSayfa.Range("A1:H1") = Array("Sıra", "Etiket(Tag) Adı", "Sınıf Adı(classname)", _
"ID Değeri", "innerText Değeri", "outerText Değeri", "innerHTML Değeri", "outerHTML Değeri")
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
Set ie = CreateObject("InternetExplorer.Application")
With ie
    .Visible = False
    .navigate "https://www.google.com.tr/?gfe_rd=cr&ei=iFDCWIi1Nq_i8AekiKSYDg&gws_rd=ssl"
  
        Do While .busy: DoEvents: Loop
        Do Until .readystate = 4: DoEvents: Loop
For Each eleman In .document.All
i = i + 1
    With YeniSayfa
        DoEvents
        .Cells(i, 1) = i
        .Cells(i, 2) = eleman.Tagname: .Cells(i, 2).WrapText = False
        .Cells(i, 3) = eleman.classname: .Cells(i, 3).WrapText = False
        .Cells(i, 4) = eleman.ID: .Cells(i, 4).WrapText = False
        .Cells(i, 5) = eleman.innertext: .Cells(i, 5).WrapText = False
        .Cells(i, 6) = eleman.outerText: .Cells(i, 6).WrapText = False
        .Cells(i, 7) = eleman.innerHTML: .Cells(i, 7).WrapText = False
        .Cells(i, 8) = eleman.outerHTML: .Cells(i, 8).WrapText = False
    End With
Next
Range("A1:J" & i).Borders.LineStyle = xlContinuous
.Quit
End With
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With
Set ie = Nothing: Set YeniSayfa = Nothing: Set ie = Nothing:
End Sub