• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

İnternet sayfasındaki buton isminin ID adresini bulma

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.
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"
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:
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
 
Ben bu tür işlerde aşağıdaki şekilde kullanıyorum.

Kırmızı : tag adı "a","input","button","li" gibi
Mavi: tag özelliği ID, görünen yazı innertext, NAME,htmltext gibi
Yeşil: tag özelliğinin değeri, "Listele" "Giriş","j_idt106_start" gibi
Turuncu: tag için yapılacak işlem.
buton ise "Click"
input ise value
il input kutusu için ,
objCollection(i).value="İstanbul"
Kod:
Set objCollection = ie.document.getElementsByTagName([B][COLOR=Red]"span"[/COLOR][/B])
    i = 0
    Do While i < objCollection.Length
      If objCollection(i).[B][COLOR=Blue]innerText[/COLOR] [/B]= [B][COLOR=Lime]"Listele"[/COLOR][/B] Then
         objCollection(i).[COLOR=DarkOrange][B]Click[/B][/COLOR]
         Exit Do
      End If
      i = i + 1
    Loop
 
asri Bey verdiğiniz kodu Ekle butonu için denedim
Kod:
    Set objCollection = IE.document.GetElementsByTagName("span")
      i = 0
        Do While i < objCollection.Length
        If objCollection(i).innerText = "Ekle" Then
          objCollection(i).Click
          Exit Do
        End If
        i = i + 1
        Loop
Sorunsuz çalıştı. Çok teşekkür ederim ilginize.
 
Geri
Üst