- Katılım
- 7 Mayıs 2009
- Mesajlar
- 22
- Excel Vers. ve Dili
- Office 2010
Aşağıda yazdığım kodlar sorunsuz olarak çalışıyor. Fakat site arka kodlarında bazen değişiklik oluyor bu yüzden de program hata veriyor.
Burdaki "Ekle Bul Yükle" sabitleri buton isimleridir. ID isimleri değiştiğinde VB ile otomatik olarak buton ismine göre ID'yi bulabilir miyiz? Yardımlarınızı bekliyorum. Şimdiden teşekkür ederim.
Kod:
[B]Ekle[/B] = "veriGirisForm:dtVeriGiris:j_idt179"
[B]Bul[/B] = "veriGirisForm:j_idt144"
[B]Yükle[/B] = "veriGirisForm:j_idt151"
[B]Resim[/B] = "j_idt106_start"
Kod:
Function FnWait(intTime)
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + intTime
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
End Function
Sub YTBS_Giris()
Dim URL As String
Dim HTML_Body As Object
Dim IE As Object
Dim Satir As Integer
Dim Saat, Tarih, Bugün, Trip
'sayfa butonları
Ekle = "veriGirisForm:dtVeriGiris:j_idt179"
Bul = "veriGirisForm:j_idt144"
Yükle = "veriGirisForm:j_idt151"
Resim = "j_idt106_start"
'----------------
URL = "https://ytbs.teias.gov.tr/ytbs/frm_login.jsf"
Tarih = Range("F2").Value
Range("G2").Value = Mid(Range("G1").Value, 1, 2) & "/" & Mid(Range("G1").Value, 4, 2) & "/" & Mid(Range("G1").Value, 7, 4)
Bugün = Range("G2").Value
SayfaGoruntulenemiyor:
Set IE = CreateObject("InternetExplorer.Application")
Application.Worksheets(1).Range("E15").Value = "01:00"
Application.Worksheets(2).Range("E15").Value = "01:00"
Application.Worksheets(3).Range("E15").Value = "01:00"
Application.Worksheets(4).Range("E15").Value = "01:00"
With IE
.Navigate URL
.Visible = True
End With
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
On Error GoTo Okey
mesaj = Mid(IE.Document.all("mainTitle").innertext, 1, 8)
If mesaj = "Bu sayfa" Or mesaj = "Ağa bağl" Then
IE.Quit
Set IE = Nothing
Set HTML_Body = Nothing
GoTo SayfaGoruntulenemiyor
End If
Okey:
IE.Document.all("loginForm:username").Value = "medmar"
IE.Document.all("loginForm:password").Value = "Medmar123"
IE.Document.all("loginForm:btnLogin").Click
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
IE.Document.GetElementByID("form2:hm1").Click
FnWait (1)
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
IE.Document.all("veriGirisForm:tarih_input").Value = Tarih
IE.Document.all(Bul).Click
Do While IE.Document.GetElementByID(Resim).Style.display = "block": DoEvents: Loop
FnWait (2)
AraDegerler = Mid(IE.Document.GetElementByID("veriGirisForm:j_idt134").innertext, 39, 47)
'If Format(Now, "hh") = 1 Then
If AraDegerler = "19:30, 19:40, 19:50, 20:00, 20:10, 20:20, 20:30" Then
Application.Worksheets("Pazar 2").Select
End If
If AraDegerler = "11:00, 11:10, 11:20, 11:30, 11:40, 11:50, 12:00" Then
Application.Worksheets("Cumartesi").Select
End If
If AraDegerler = "15:00, 15:10, 15:20, 15:30, 15:40, 15:50, 16:00" Then
Application.Worksheets("Hafta İçi").Select
End If
If AraDegerler = "21:00, 21:10, 21:20, 21:30, 21:40, 21:50, 22:00" Then
Application.Worksheets("Pazar").Select
End If
'End If
Range("E15").Value = Mid(IE.Document.GetElementByID("veriGirisForm:dtVeriGiris:selectedZaman_input").innertext, 1, 5)
Range("E16").Value = Mid(IE.Document.GetElementByID("veriGirisForm:dtVeriGiris:selectedZaman_input").innertext, 1, 2)
Range("E17").Value = Format(Now, "hh")
Range("E18").Value = Mid(IE.Document.GetElementByID("veriGirisForm:tarih_input").Value, 1, 2)
Range("E19").Value = Day(Now)
Satir = Range("E11").Value
Do While IE.Document.GetElementByID(Resim).Style.display = "block": DoEvents: Loop
FnWait (2)
' *verilerin ilk satırını seç*
Range("B" & Range("E11").Value).Select
' Do döngüsünü boş hücreye ulaşıldığında duracak şekilde ayarla.
Do Until IsEmpty(ActiveCell)
Range("E12").Value = Mid(IE.Document.GetElementByID("veriGirisForm:dtVeriGiris:selectedZaman_input").innertext, 1, 2)
If FormatNumber(ActiveCell.Value, 2) = "0,00" And FormatNumber(Range("D" & Satir).Value, 2) < "0,00" Then
Exit Do
End If
If FormatNumber(Range("B" & Satir).Value, 2) = "0,01" Then
Range("B" & Satir).Value = ""
Range("D" & Satir).Value = ""
IE.Document.GetElementByID("veriGirisForm:kopyaAlani").Value = Range("B" & Satir).Value _
+ " " + FormatNumber(Range("C" & Satir).Value, 2) + " " + Range("D" & Satir).Value
GoTo Geç
End If
IE.Document.GetElementByID("veriGirisForm:kopyaAlani").Value = FormatNumber(Range("B" & Satir).Value, 2) _
+ " " + FormatNumber(Range("C" & Satir).Value, 2) + " " + FormatNumber(Range("D" & Satir).Value, 2)
Geç:
IE.Document.GetElementByID(Yükle).Click
Do While IE.Document.GetElementByID(Resim).Style.display = "block": DoEvents: Loop
FnWait (2)
IE.Document.GetElementByID(Ekle).Click
Do While IE.Document.GetElementByID(Resim).Style.display = "block": DoEvents: Loop
FnWait (2)
' Geçerli konumdan 1 satır aşağı git.
ActiveCell.Offset(1, 0).Select
If Range("B" & Satir).Value = "" Then
Range("B" & Satir).Value = "0,01"
Range("D" & Satir).Value = "0,01"
End If
Satir = Satir + 1
Call FnWait(2)
Loop
Do While IE.Document.GetElementByID(Resim).Style.display = "block": DoEvents: Loop
FnWait (2)
With IE
.Navigate "https://ytbs.teias.gov.tr/ytbs/"
End With
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
FnWait (3)
IE.Quit
Set IE = Nothing
Set HTML_Body = Nothing
CreateObject("WScript.Shell").Popup "İşlem tamamlandı.", 5
'MsgBox "İşlem Tamamlandı..", vbInformation, "Tebrikler"
End Sub
