Websorgusunda sıkıntı

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,071
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Arkadaşlar, kullandığım dosyada belirli bir aşamaya geldim. Kullandığım site sayın harziyan'ın da sık sık sorduğu Gıda Tarım ve Hayvancılık Bakanlığı'nın çiftçi kayıt sistemi. Bu site hem şifreli hem de ip kısıtlamalı olduğundan maalesef siz giremezsiniz. ancak sayfanın ilgili yerinin kodlarını aşağıda veriyorum. Bu kısımda Arazi bilgileri linkine tıklayıp (aslında link değil javasicript olarak ayarlamışlar) daha sonra eglen sayfada da başka bir şlem yaptırmam gerekiyor. Kullandığım kodları gönderiyorum. Bu kodlarda "Arazi bilgilerini açıyoruz" kısmında sorun var. Orası açılmıyor maalesef.

Sayfa kodları:

Kod: 
</table></td><td id="ctl00_M_TC_AraziBilgileri"><table class="tabLevel_2" cellspacing="0" cellpadding="0" border="0" style="border-width:0px;width:100%;border-collapse:collapse;">
						<tr>
							<td style="white-space: nowrap"><a id="ctl00_M_LB_AraziBilgileri" class="tabLevel_2" href="javascript:WebForm_DoPostBackWithOptions(new WebForm_PostBackOptions("ctl00$M$LB_AraziBilgileri", "", true, "", "", false, true))">Arazi Bilgileri</a></td>
						</tr>
Kullandığım kodlar:

Kod: 
Dim IE As Object


Sub bekle()
    With IE
        Do Until .ReadyState = 4: DoEvents: Loop
        Do While .Busy: DoEvents: Loop
    End With
End Sub



Sub ie_olustur()
     Set IE = CreateObject("InternetExplorer.Application")
     IE.Visible = True
    'IE.Visible = False
     IE.Navigate "http://cks.tarim.gov.tr/"
     Call bekle
End Sub

Sub CKS_Sorgula()
        tcno = Range("d6").Value
        
        With IE
           'Kullanıcı Adı Bölümü
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "txtKullaniciAd" And objcollection(i).ID = "txtKullaniciAd" Then
                 objcollection(i).Value = "kullanıcıadım"
                 Exit Do
              End If
              i = i + 1
           Loop
           'Şifre Bölümü
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "txtParola" And objcollection(i).ID = "txtParola" Then
                 objcollection(i).Value = "şifrem"
                 Exit Do
              End If
              i = i + 1
           Loop
           'Butona Basıyoruz
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "btnGiris" And objcollection(i).Type = "submit" Then
                 objcollection(i).Click
                 Exit Do
              End If
              i = i + 1
        Loop
        Call bekle
        Application.Wait Now + TimeSerial(0, 0, 1)
        
        IE.Navigate "https://cks.tarim.gov.tr/CKS/TemelCKS/IsletmeBilgileri/UretimSezonuIsletmeKaydi.aspx"
          Application.Wait Now + TimeSerial(0, 0, 1)
          'TC kimlik no Bölümü
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "ctl00$O$KG_USIK$TB_TCKimlikNo" And objcollection(i).ID = "ctl00_O_KG_USIK_TB_TCKimlikNo" Then
                 objcollection(i).Value = tcno
                 Exit Do
              End If
              i = i + 1
           Loop
            'Butona Basıyoruz
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "ctl00$O$B_Devam" And objcollection(i).Type = "submit" Then
                 objcollection(i).Click
                 Exit Do
              End If
              i = i + 1
        Loop
         Application.Wait Now + TimeSerial(0, 0, 1)
         Application.Wait Now + TimeSerial(0, 0, 1)
        
       [B][COLOR="DarkRed"] 'Arazi kaydını açıyoruz
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).ID = "ctl00_M_TC_AraziBilgileri" Then
                 objcollection(i).Click
                 Exit Do
              End If
              i = i + 1[/COLOR][/B]
        Loop
        'Ürün dağılımını açıyoruz
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "ctl00$O$A$B_UrunDagilimi" And objcollection(i).Type = "submit" Then
                 objcollection(i).Click
                 Exit Do
              End If
              i = i + 1
        Loop
        Call bekle
        Application.Wait Now + TimeSerial(0, 0, 1)
    End With
End Sub
Yardımlarınızı rica ediyorum.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,071
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sorunumu çözdüm arkadaşlar. kodlar aşağıdaki şekilde olmalıymış:

Kod: 
Dim IE As Object


Sub bekle()
    With IE
        Do Until .ReadyState = 4: DoEvents: Loop
        Do While .Busy: DoEvents: Loop
    End With
End Sub



Sub ie_olustur()
     Set IE = CreateObject("InternetExplorer.Application")
     IE.Visible = True
    'IE.Visible = False
     IE.Navigate "http://cks.tarim.gov.tr/"
     Call bekle
End Sub

Sub CKS_Sorgula()
        tcno = Range("d6").Value
        
        With IE
           'Kullanıcı Adı Bölümü
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "txtKullaniciAd" And objcollection(i).ID = "txtKullaniciAd" Then
                 objcollection(i).Value = "kullanıcıadım"
                 Exit Do
              End If
              i = i + 1
           Loop
           'Şifre Bölümü
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "txtParola" And objcollection(i).ID = "txtParola" Then
                 objcollection(i).Value = "şifrem"
                 Exit Do
              End If
              i = i + 1
           Loop
           'Butona Basıyoruz
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "btnGiris" And objcollection(i).Type = "submit" Then
                 objcollection(i).Click
                 Exit Do
              End If
              i = i + 1
        Loop
        Call bekle
        Application.Wait Now + TimeSerial(0, 0, 1)
         Application.Wait Now + TimeSerial(0, 0, 1)
        IE.Navigate "https://cks.tarim.gov.tr/CKS/TemelCKS/IsletmeBilgileri/UretimSezonuIsletmeKaydi.aspx"
          Application.Wait Now + TimeSerial(0, 0, 1)
          'TC kimlik no Bölümü
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "ctl00$O$KG_USIK$TB_TCKimlikNo" And objcollection(i).ID = "ctl00_O_KG_USIK_TB_TCKimlikNo" Then
                 objcollection(i).Value = tcno
                 Exit Do
              End If
              i = i + 1
           Loop
            'Butona Basıyoruz
           Set objcollection = .Document.getElementsByTagName("input")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).Name = "ctl00$O$B_Devam" And objcollection(i).Type = "submit" Then
                 objcollection(i).Click
                 Exit Do
              End If
              i = i + 1
        Loop
         Application.Wait Now + TimeSerial(0, 0, 1)
         Application.Wait Now + TimeSerial(0, 0, 1)
        
        'Arazi kaydını açıyoruz
           Set objcollection = .Document.getElementsByTagName("a")
           i = 0
           Do While i < objcollection.Length
              If objcollection(i).ID = "ctl00_M_LB_AraziBilgileri" Then
                 objcollection(i).Click
                 Exit Do
              End If
              i = i + 1
        Loop
        Application.Wait Now + TimeSerial(0, 0, 1)
        'Ürün dağılımını açıyoruz
        IE.Navigate "https://cks.tarim.gov.tr/CKS/TemelCKS/IsletmeBilgileri/AraziUrunlerDagilimi.aspx"

           
        Call bekle
        Application.Wait Now + TimeSerial(0, 0, 1)
    End With
End Sub
Şimdi asıl sorunum ise bu kodlar her seferinde yeni bir internet explorer sayfası açtığından, ie yerine doğrudan excel içinde userform üzerindeki webbrowserla halletmek. Birkaç kez denedim ama ie'de çalışan kodlar userformda çalışmadı maalesef.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst