Dim Web As Object

Sub SorgulaB()

Dim Son As Integer, Say As Integer

Son = ActiveSheet.Range("A65536").End(xlUp).Row

Set Web = CreateObject("InternetExplorer.application")

Web.Navigate "http://www.ailehekimibul.com"

For Say = 2 To Son

Denetle ActiveSheet.Range("A" & Say).Value, Say

Next

Set Web = Nothing

MsgBox "İşlem tamam.", vbInformation, "Sonuç"

End Sub



Sub Denetle(TC, Say)

On Error GoTo Hata

Web.Navigate "http://www.ailehekimibul.com"

Do While Web.Busy: DoEvents: Loop

Do While Web.ReadyState <> 4: DoEvents: Loop

Web.Document.getElementById("tc").Value = TC

Web.Document.getElementById("Sorgula").Click



Do While Web.Busy: DoEvents: Loop

Do While Web.ReadyState <> 4: DoEvents: Loop



With ActiveSheet

.Range("B" & Say).Value = Web.Document.all.tags("table").Item(6).Rows(1).Cells(1).innerText

.Range("C" & Say).Value = Web.Document.all.tags("table").Item(6).Rows(2).Cells(1).innerText

.Range("D" & Say).Value = Web.Document.all.tags("table").Item(6).Rows(3).Cells(1).innerText

.Range("E" & Say).Value = Web.Document.all.tags("table").Item(6).Rows(4).Cells(1).innerText

End With

Exit Sub

Hata:

Range("A1") = Err.Number

If Err.Number = 91 Then

Err.Clear

Do While Web.Busy: DoEvents: Loop

Do While Web.ReadyState <> 4: DoEvents: Loop

If InStr(Web.Document.all.tags("table").Item(2).innerText, "SORGULADIĞINIZ KİŞİNİN") > 0 Then Exit Sub

Resume

Else: Exit Sub

End If

End Sub