- Katılım
- 12 Mayıs 2016
- Mesajlar
- 386
- Excel Vers. ve Dili
- Ofis 2019- 32 Bit - Türkçe
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
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
Kod:
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