Aşağıdaki makroyu
http://212.175.55.242/Ah_bul.aspx
adresi için uyarlayamaya yardımcı olurmu sunuz ?
http://212.175.55.242/Ah_bul.aspx
adresi için uyarlayamaya yardımcı olurmu sunuz ?
Kod:
Sub Sorgula()
Dim Web As Object, Son As Integer, Say As Integer
With ActiveSheet
Son = ActiveSheet.Range("A65536").End(xlUp).Row
Set Web = CreateObject("InternetExplorer.application")
For Say = 2 To Son
Web.Navigate2 "http://www.ailehekimibul.com/"
Do While Web.Busy: DoEvents: Loop
Do While Web.ReadyState <> 4: DoEvents: Loop
Web.Document.getElementById("TcNo").Value = .Range("A" & Say).Value
Web.Document.getElementById("Sorgula").Click
Do While Web.Busy: DoEvents: Loop
Do While Web.ReadyState <> 4: DoEvents: Loop
On Error GoTo Hata
.Range("B" & Say).Value = Web.Document.All.tags("table").Item(6).Rows(2).Cells(1).innerText
.Range("C" & Say).Value = Web.Document.All.tags("table").Item(5).Rows(2).Cells(1).innerText
.Range("D" & Say).Value = Web.Document.All.tags("table").Item(5).Rows(3).Cells(1).innerText
Next
End With
Set Web = Nothing
MsgBox "Islem Tamam", vbInformation, "Sonuç"
Exit Sub
Hata:
If Err.Number = 91 Then
Resume
Else: MsgBox "Hata olustu.", vbCritical, "Hata"
End If
End Sub
Son düzenleme:
