• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro uyarlama

Katılım
17 Temmuz 2008
Mesajlar
4
Excel Vers. ve Dili
excel
Aşağıdaki makroyu
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:
Konuyla ilgili yardımcı olacak bir arkadaş yok mu ?
 
Geri
Üst