DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Const URL As String = "http://649.tr.net/cgi-bin/sayisal.cgi?"
Sub Test()
'
' 16-11-1996 tarihinden bugüne kadar olan tüm sayisal loto sonuçlarını web'den alır....
' Haluk ®
'
Dim StartDate As Date
Dim IE As Object
Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object
Range("A1:G2000").ClearContents
Range("A1") = "Cekilis Tarihi"
Range("B1") = "1nci Sayi"
Range("C1") = "2nci Sayi"
Range("D1") = "3ncu Sayi"
Range("E1") = "4ncu Sayi"
Range("F1") = "5nci Sayi"
Range("G1") = "6nci Sayi"
Range("A1:G1").Font.Bold = True
Range("A1:G1").Font.Color = vbRed
StartDate = DateValue("09/11/1996")
MyDate = Format(StartDate, "yyyymmdd")
Set IE = CreateObject("InternetExplorer.Application")
For i = 2 To DateDiff("ww", StartDate, Date) + 1
j = j + 1
MyDate = DateAdd("ww", j, StartDate)
Range("A" & i) = Format(MyDate, "dd/mm/yyyy")
With IE
.Navigate URL & Format(MyDate, "yyyymmdd")
Do Until IE.ReadyState = 4: DoEvents: Loop
With .Document.all
On Error Resume Next
.haftalar.Value = Range("A" & i)
On Error GoTo 0
End With
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(4)
Range("B" & i) = MyTable.Rows(0).Cells(0).InnerText
Range("C" & i) = MyTable.Rows(0).Cells(1).InnerText
Range("D" & i) = MyTable.Rows(0).Cells(2).InnerText
Range("E" & i) = MyTable.Rows(0).Cells(3).InnerText
Range("F" & i) = MyTable.Rows(0).Cells(4).InnerText
Range("G" & i) = MyTable.Rows(0).Cells(5).InnerText
Range("h" & i) = "'" & Range("B" & i) & Range("c" & i) & Range("d" & i) & Range("e" & i) & Range("f" & i) & Range("g" & i)
End With
Next
GoTo SafeExit:
ErrHandler:
MsgBox "Bilgi bulunamadi veya internet erisimi yetersiz ...", vbCritical, "Kullanicinin dikkatine..."
SafeExit:
Columns(1).AutoFit
Set HTML_Body = Nothing
Set HTML_Tables = Nothing
Set MyTable = Nothing
Set HTML_TableRows = Nothing
Set HTML_TableDivisions = Nothing
Set IE = Nothing
End Sub
ben bu dosyayı indiremiyorum acaba nedendirArkadaşlar balık tutmayı ögretiyor.
Siz illaki hazır pişmiş olsun diyorsun.
İstediğiniz bumudur.
Ekteki dosyayı inceleyiniz.