Soru İmsakiye Kod Hatası

[okan32]

S.A ARKADAŞLAR DAHA ÖNCE HALUK HOCAMIN YAPMIŞ OLDUĞU İMSAKİYE PROGRAMI KODLARINI KENDİME GÖRE UYARLAMIŞTIM.
AŞAĞIDAKİ KOD İLE DİYANET SİTESİNDEN İMSAKİYE VERİLERİNİ ÇEKİYORDUM. AMA KALIN YAZILI KOD SATIRINDA HATA VERİYOR. YARDIMLARINIZI BEKLİYORUM

Sub imsakiye()
'On Error Resume Next
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")

Cells.Interior.ColorIndex = xlNone
Cells.ClearContents
sat = 2
With ie
ie.Visible = 1
.Visible = 1
.Width = 50
.Height = 50
.Left = 20
.Top = 0

ie.Navigate "http://ramazan.diyanet.gov.tr/tr-TR/Imsakiye"

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
ie.Visible = 1

For k = 1 To ie.document.All("ulkeId").Length - 1
If ie.document.All.ulkeId(k).Text = "Türkiye" Then
ie.document.All("ulkeId").Focus
ie.document.All("ulkeId").selectedindex = k
ie.document.All("ulkeId").onchange

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
Exit For
End If
Next k

Application.Wait (Now + TimeValue("0:00:01"))

For t = 1 To ie.document.All("ilId").Length - 1
If ie.document.All.ilId(t).Text = "ISPARTA" Then
ie.document.All("ilId").Focus
ie.document.All("ilId").selectedindex = t
ie.document.All("ilId").onchange

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
Exit For
End If
Next t

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: DoEvents: Loop


For n = 1 To ie.document.All("ilceId").Length - 1
If ie.document.All.ilceId(n).Text = "ATABEY" Then
ie.document.All("ilceId").Focus
ie.document.All("ilceId").selectedindex = n
ie.document.All("ilceId").onchange
Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
Exit For
End If
Next n

Application.Wait (Now + TimeValue("0:00:01"))

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: DoEvents: Loop

Set tbl = ie.document.getElementsByTagName("table").Item(0)
For i = 1 To tbl.Rows.Length - 1
veri = WorksheetFunction.Trim(Replace(Replace(Replace(tbl.Rows(i).Cells(0).InnerText, Chr(13), "  "), Chr(10), "  "), ",", ""))
If Left(veri, 5) = "KADİR" Then Cells(sat - 1, 9) = "Kadir Gecesi": GoTo atla
For j = 0 To tbl.Rows(i).Cells.Length - 1
Cells(sat, j + 1) = WorksheetFunction.Trim(tbl.Rows(i).Cells(j).InnerText)
Cells(sat, j + 1).WrapText = False
Next

sat = sat + 1
atla:
Next
ie.Quit: Set ie = Nothing
End With

MsgBox "işlem tamam"
End Sub

 

[okan32]

Aşağıya örnek dosyayı da ekledim.Yardımlarınız için şimdiden teşekkürler.

 

[Necdet]

Merhaba,

Ben denedim her hangi bir hata almadım.

Hata aldığınız satırı belirtirseniz ilgilenecek arkadaşlar çıkabilir.

 

[okan32]

Necdet Bey Hata Satırım
For i = 1 To tbl.Rows.Length - 1

 

[Necdet]

Merhaba,

Büyük ihtimalle internet bağlantısı yavaş, dolayısıyla bağlantı olmuyor. Kodun üzerinde 1 saniyelik bekleme satırı var, onu 1 den büyük bir rakama ayarlayın tekrar deneyin, önce 2 yapın sonra 3 gibi.

Application.Wait (Now + TimeValue("0:00:01"))

ilgili satırı yukarıya yazdım.b 1 rakamını değiştirin.

 

[okan32]

TM necdet hocam yarın deneyecğim.

 

[halit3]

Kodu muhtemelen aşağıdaki linkten aldınız.
kodun çalışması için explorer in 11 sürümü yüklü olması gerekiyor.

https://www.excel.web.tr/threads/imsakiye.149881/

 

[okan32]

Tamam halit hocam hem sizin hem de necdet hacamın önerilerini yarın deneyeceğim