Skip to main content

AccessTr.neT


EXCEL İLE WEBDEN TOPLU SORGULAMA YAPMAK

EXCEL İLE WEBDEN TOPLU SORGULAMA YAPMAK

Çözüldü #3
Sn:turuncumx
Sizin sorunuzada Sn:Muhammet Aytaş'ın bir başka arkadaşımıza verdiği cevabı örnek olarak vereyim.Muhammet arkadışımızada ayrıca verdiği cevap için teşekkürler.

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
OĞULCAN & OLCAYTUĞ

Oğulcan Excel Web Sitesi
Excel İle Programlama
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Cvp: EXCEL İLE WEBDEN TOPLU SORGULAMA YAPMAK - Yazar: ogulcan92 - 08/10/2013, 10:13