Çözüldü Webden veri alma...

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Katılım
20 Haz 2018
Mesajlar
22
En İyi Yanıtlar
0
Beğeniler
1
Puanları
3
Yaş
37
Konum
türkiye
#1
Merhaba Üstadlar,

İnternet vergi dairesinde şifre ile girilen bir bölümde araç listesi bulunmakta,
buradaki araçları excel deki hücrelere yapıştırabilir miyiz..

ScreenShot_20180825134359.jpeg


site kodları,
Kod:
<td class="cntnt">
    <p style="font-size:12;font-weight:bold;">SİZE AİT ARAÇLARIN LİSTESİ</p>

    <span style="cursor: pointer; font-size: 12px;" onmouseover="style.fontWeight='bold'" onmouseout="style.fontWeight=''" onclick="loadAJAXUsingPOST('dispatch','contentivd','cmd=IVD_MOTOP_DETAY_LOGINLI&amp;ozelPlakaAdi=70BC593&amp;plaka=70BC593&amp;vkno=XX&amp;tckno=XXXXX&amp;tescilTarihiYil=2016&amp;tescilTarihiAy=03&amp;tescilTarihiGun=xx&amp;ozelPlaka=0')"><center>70BC593</center> </span>

    <span style="cursor: pointer; font-size: 12px;" onmouseover="style.fontWeight='bold'" onmouseout="style.fontWeight=''" onclick="loadAJAXUsingPOST('dispatch','contentivd','cmd=IVD_MOTOP_DETAY_LOGINLI&amp;ozelPlakaAdi=70AE636&amp;plaka=70AE636&amp;vkno=XX&amp;tckno=XXXXX&amp;tescilTarihiYil=2017&amp;tescilTarihiAy=12&amp;tescilTarihiGun=XX&amp;ozelPlaka=0')"><center>70AE636</center> </span>

    <span style="cursor:pointer;font-size:12" onmouseover="style.fontWeight='bold'" onmouseout="style.fontWeight=''" onclick="loadAJAXUsingPOST('dispatch','contentivd','cmd=IVD_MOTOP_DETAY_LOGINLI&amp;ozelPlakaAdi=70BG165&amp;plaka=70BG165&amp;vkno=XX&amp;tckno=XXXXXXXXXXXX&amp;tescilTarihiYil=2018&amp;tescilTarihiAy=05&amp;tescilTarihiGun=XX&amp;ozelPlaka=0')"><center>70BG165</center> </span>

</td>
 
Katılım
7 Haz 2018
Mesajlar
35
En İyi Yanıtlar
8
Beğeniler
36
Puanları
18
Konum
Sakarya-Hendek
#2
Aşağıdaki prosedur işinizi görecektir...
VBA:
Sub Test()
    htmlcode = Sayfa1.[a1]
    
    Set reg = CreateObject("VBScript.RegExp")
    
    reg.ignorecase = True
    reg.Global = True
        
    [a1:f1].Value = Array("plaka", "vkno", "tckno", "tescilTarihiYil", "tescilTarihiAy", "tescilTarihiGun")
    [a1:f1].Font.Bold = True
    
    For Each ar In Array("<center>(.+)</center>", "vkno=(\d{10})", "tckno=(\d{11})", "tescilTarihiYil=(\d{2,4})", "tescilTarihiAy=(\d{1,2})", "tescilTarihiGun=(\d{1,2})")
    
        reg.Pattern = ar
        
        r = 1
        
        c = c + 1
        
        If reg.Test(htmlcode) Then
            
            For Each m In reg.Execute(htmlcode)
            
                r = r + 1
                
                Cells(r, c) = m.submatches(0)
                
            Next
            
        End If
        
    Next
    
End Sub
 
Katılım
20 Haz 2018
Mesajlar
22
En İyi Yanıtlar
0
Beğeniler
1
Puanları
3
Yaş
37
Konum
türkiye
#3
Üstat maalesef olmadı. önceki giriş kodlarını ve sayfa kodlarını ekliyorum, bakabilir misiniz...

Kod:
Dim ie As Object, yeni As Object

    basla = Timer: While (Timer - basla) < 1: Wend
    Set ie = CreateObject("internetexplorer.application")
    With ie
        .Visible = True
        .Navigate "https://intvd.gib.gov.tr/internetvd/index.jsp"
        Do While ie.Busy: DoEvents: Loop: Do While Not ie.ReadyState = 4: DoEvents: Loop
        ie.Navigate "javascript:openLoginPopup()"
        basla = Timer: While (Timer - basla) < 1: Wend
    End With
     With CreateObject("Shell.Application")
        For Each pencere In .Windows()
            If UCase(pencere.FullName) Like "*IEXPLORE*" Then
                ie.Quit
                Set yeni = pencere.Application
            End If
        Next pencere
    End With
yeni.Document.getElementById("username").Value = Cells(28, "a")
yeni.Document.getElementById("password2").Value = Cells(29, "a")
yeni.Document.getElementById("password1").Value = Cells(30, "a")

' TAMAM TIKLAMA
Set HtmlDoc = yeni.Document
Set form = HtmlDoc.Forms(0)
For Each Evn_Element In form.getElementsByTagName("INPUT")
    If Evn_Element.Type = "image" Then Evn_Element.Click: Exit For
Next Evn_Element
 ' TAMAM TIKLAMA BİTTİ

Kod:
<tr><td class="le">&nbsp;</td><td class="cntnt">
    <p style="font-size:12;font-weight:bold;">SİZE AİT ARAÇLARIN LİSTESİ</p>
    <span style="cursor:pointer;font-size:12px;"onmouseover="style.fontWeight='bold'" onmouseout="style.fontWeight=''" onclick="loadAJAXUsingPOST('dispatch','contentivd','cmd=IVD_MOTOP_DETAY_LOGINLI&amp;ozelPlakaAdi=70BC593&amp;plaka=70BC593&amp;vkno=xxxx296338&amp;tckno=xxxxx173654&amp;tescilTarihiYil=2016&amp;tescilTarihiAy=03&amp;tescilTarihiGun=xx&amp;ozelPlaka=0')"><center>70BC593</center> </span>
    <span style="cursor:pointer;font-size:12"   onmouseover="style.fontWeight='bold'" onmouseout="style.fontWeight=''" onclick="loadAJAXUsingPOST('dispatch','contentivd','cmd=IVD_MOTOP_DETAY_LOGINLI&amp;ozelPlakaAdi=70AE636&amp;plaka=70AE636&amp;vkno=xxxx296338&amp;tckno=xxxxx173654&amp;tescilTarihiYil=2017&amp;tescilTarihiAy=12&amp;tescilTarihiGun=xx&amp;ozelPlaka=0')"><center>70AE636</center> </span>
    <span style="cursor:pointer;font-size:12"   onmouseover="style.fontWeight='bold'" onmouseout="style.fontWeight=''" onclick="loadAJAXUsingPOST('dispatch','contentivd','cmd=IVD_MOTOP_DETAY_LOGINLI&amp;ozelPlakaAdi=70BG165&amp;plaka=70BG165&amp;vkno=xxxx296338&amp;tckno=xxxxx173654&amp;tescilTarihiYil=2018&amp;tescilTarihiAy=05&amp;tescilTarihiGun=xx&amp;ozelPlaka=0')"><center>70BG165</center> </span>
</td><td class="re">&nbsp;</td></tr>
 

Admin

Yönetici
Site Sahibi
Katılım
25 May 2018
Mesajlar
1,000
En İyi Yanıtlar
72
Beğeniler
773
Puanları
113
Konum
İstanbul
#5
Kullanıcı Kodu, Parola ve Şifre bilgileri olsaydı yardımcı olabilirdim.
 

Admin

Yönetici
Site Sahibi
Katılım
25 May 2018
Mesajlar
1,000
En İyi Yanıtlar
72
Beğeniler
773
Puanları
113
Konum
İstanbul
#7
Merhaba @karizmax,

Gönderdiğiniz dosyaya UserForm ve üzerine de Web Browser'i ve CommandButton'u ekleyin..
O butona da bu kodları yapıştırın..
VBA:
Private Sub CommandButton1_Click()
    Shell "taskkill /f /im iexplore*"
    basla = Timer: While (Timer - basla) < 1.5: Wend
    WebBrowser1.Navigate ("about:<html><head><script>window.opener=window;window.location = 'https://intvd.gib.gov.tr/internetvd/dispatch2?cmd=IVD_LOGINPAGE';</script></head></html>")
    basla1 = Timer: While (Timer - basla1) < 3: Wend
    On Error Resume Next
    WebBrowser1.Document.getElementById("username").Value = Cells(1, "b")
    WebBrowser1.Document.getElementById("password2").Value = Cells(2, "b")
    WebBrowser1.Document.getElementById("password1").Value = Cells(3, "b")
    Set HtmlDoc = WebBrowser1.Document
    Set form = HtmlDoc.Forms(0)
    For Each Evn_Element In form.getelementsbytagname("INPUT")
        If Evn_Element.Type = "image" Then Evn_Element.Click: Exit For
    Next Evn_Element
    basla2 = Timer: While (Timer - basla2) < 3: Wend
    WebBrowser1.Navigate ("javascript:loadAJAXUsingPOST('dispatch', 'contentivd', 'cmd=IVD_MTV_PLAKA_LIST')")
    MsgBox "Alınıyor.."
    basla3 = Timer: While (Timer - basla3) < 2: Wend: a = 9
    For Each plaka In WebBrowser1.Document.getelementsbytagname("center")
        Cells(a, 1) = plaka.innertext
        a = a + 1
    Next plaka
    MsgBox "Plâkalar Alındı.", vbInformation, "Www.ExcelTurkey.Com"
    Unload Me
End Sub
 

karizmax

Yeni Üye
Katılım
20 Haz 2018
Mesajlar
22
En İyi Yanıtlar
0
Beğeniler
1
Puanları
3
Yaş
37
Konum
türkiye
#8
Teşekkür, çok çok teşekkür ederim sayın admin, ellerinize sağlık.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Üst Alt