Değerli Dostlar Selamlar,
Aşağıda eklediğim Sayın Haluk'a ait Emekli Sandığı Sorgusunu döngü yaparak 1 er satır kaydırmak suretiyle 200. satıra kadar devam ettirmek istiyorum. İstiyorum ki A,B,C sütunlarına benim verilerimi girdikten sonra sorgulamaya başlayınca 5. satırda işlem yapsın. Ve 200. satıra kadar tekrarlasın.
Const URL As String = "http://www.emekli.gov.tr/bilgi/SicilTespitiServlet1"
Sub Test()
'
'Emekli Sandigi' ndan sorgulama ....
'29/06/2006 - Raider ®
'
Dim Data(1 To 3) As String
Dim IE As Object
Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object
Dim RetVal As Variant
Range("D5:G5").ClearContents
Data(1) = Range("A5")
Data(2) = Range("B5")
Data(3) = Range("C5")
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate URL
Do Until IE.ReadyState = 4: DoEvents: Loop
With .Document.all
.soyad.Value = Data(1)
.ad2.Value = Data(2)
.dogumYil.Value = Data(3)
End With
IE.Document.Forms(0).Elements("mevzuatgoruntuleButon").Click
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
On Error GoTo ErrHandler:
Set HTML_Body = IE.Document.Body
Set HTML_Tables = HTML_Body.GetElementsByTagName("Table")
Set MyTable = HTML_Tables(2)
Range("D5") = MyTable.Rows(3).Cells(1).InnerText
Range("E5") = MyTable.Rows(3).Cells(2).InnerText
Range("F5") = MyTable.Rows(3).Cells(3).InnerText
Range("G5") = MyTable.Rows(3).Cells(5).InnerText
End With
GoTo SafeExit:
ErrHandler:
'MsgBox "Bilgi bulunamadi", vbCritical, "Kullanicinin dikkatine..."
SafeExit:
Set HTML_Body = Nothing
Set HTML_Tables = Nothing
Set MyTable = Nothing
Set HTML_TableRows = Nothing
Set HTML_TableDivisions = Nothing
Set IE = Nothing
End Sub
Aşağıda eklediğim Sayın Haluk'a ait Emekli Sandığı Sorgusunu döngü yaparak 1 er satır kaydırmak suretiyle 200. satıra kadar devam ettirmek istiyorum. İstiyorum ki A,B,C sütunlarına benim verilerimi girdikten sonra sorgulamaya başlayınca 5. satırda işlem yapsın. Ve 200. satıra kadar tekrarlasın.
Const URL As String = "http://www.emekli.gov.tr/bilgi/SicilTespitiServlet1"
Sub Test()
'
'Emekli Sandigi' ndan sorgulama ....
'29/06/2006 - Raider ®
'
Dim Data(1 To 3) As String
Dim IE As Object
Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object
Dim RetVal As Variant
Range("D5:G5").ClearContents
Data(1) = Range("A5")
Data(2) = Range("B5")
Data(3) = Range("C5")
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate URL
Do Until IE.ReadyState = 4: DoEvents: Loop
With .Document.all
.soyad.Value = Data(1)
.ad2.Value = Data(2)
.dogumYil.Value = Data(3)
End With
IE.Document.Forms(0).Elements("mevzuatgoruntuleButon").Click
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
On Error GoTo ErrHandler:
Set HTML_Body = IE.Document.Body
Set HTML_Tables = HTML_Body.GetElementsByTagName("Table")
Set MyTable = HTML_Tables(2)
Range("D5") = MyTable.Rows(3).Cells(1).InnerText
Range("E5") = MyTable.Rows(3).Cells(2).InnerText
Range("F5") = MyTable.Rows(3).Cells(3).InnerText
Range("G5") = MyTable.Rows(3).Cells(5).InnerText
End With
GoTo SafeExit:
ErrHandler:
'MsgBox "Bilgi bulunamadi", vbCritical, "Kullanicinin dikkatine..."
SafeExit:
Set HTML_Body = Nothing
Set HTML_Tables = Nothing
Set MyTable = Nothing
Set HTML_TableRows = Nothing
Set HTML_TableDivisions = Nothing
Set IE = Nothing
End Sub