kod içindeki metini excele almak.

K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
Üstadlar kolay gelsin. İnternet sayfasından aşağıdaki kodda yer alan "Kalan devamsızlığı:14" yazan kısmı yada sadece "14" ü olan kısmı excele aktarmak istiyorum fakat beceremedim. Yardımlarınızı bekliyorum.

<div id="ctl03_pnKontroller">

<div id="ctl03_pnTypCalisanDevamTakipIslemleri">

<div class="row-fluid">

::before

<div class="span7">

<strong class="text-info">Katılımcının;</strong>

<br>

<p>

<strong class="text-error">Kalan Devamsızlığı: 14</strong>

“&nbsp;&nbsp;”

<br>

<strong>T.C. Kimlik Numarası:</strong>

“ 111111111111&nbsp;&nbsp;”
 
mancubus

mancubus

Destek Ekibi
Destek Ekibi
Katılım
6 Ocak 2010
Mesajlar
2,224
Excel Vers. ve Dili
İŞ: 2021 Win Eng
aşağıdakine benzer bir yöntem ile http://xxx.com/yyy/zzz.php yerine kendi sitenizin adresini yazarak bu değeri döndürdüğünüzü var sayıyorum.
ben bunu xmlhttpMetin adında değişkene atadım.

JSON: 
Sub xlTR_194097()

    Dim xmlhttpMetin As String, rakamMetin As String
    Dim i As Long
    Dim dizi
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://xxx.com/yyy/zzz.php", False
        .Send
        xmlhttpMetin = .ResponseText
    End With
    
    dizi = Split(xmlhttpMetin, "Kalan Devamsızlığı: ")
    
    For i = 1 To Len(dizi(1))
        If IsNumeric(Mid(dizi(1), i, 1)) Then
            rakamMetin = rakamMetin & Mid(dizi(1), i, 1)
        Else
            Exit For
        End If
    Next i
    
    MsgBox CLng(rakamMetin)

End Sub
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Alternatif;

C#: 
Sub Test()
'   Haluk - 30/03/2021
'   Referanslar:
'       - Microsoft XML, V6.0
'       - Microsoft HTML Object Library

    Dim HTTP As New XMLHTTP60, HTML As New HTMLDocument
    Dim xElement As Object
    
    URL = ThisWorkbook.Path & "\trt.html"

    HTTP.Open "GET", URL, False
    HTTP.Send
    HTML.body.innerHTML = HTTP.responseText

    Set xElement = HTML.getElementsByClassName("text-error")
    
    If xElement.Length > 0 Then
        MsgBox xElement(0).innerText
    Else
        MsgBox "Kalan Devamsızlık bulunamadı..."
    End If
End Sub
.
 
P

PColik

Katılım
17 Ekim 2011
Mesajlar
31
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Merhaba bir alternatif de benden olsun isterim ancak veri alacağınız sitede "text-error" sınıfında birden fazla veri bulunuyorsa istediğiniz veriyi alamamanız mümkündür. Aşağıdaki kodlar arka planda bir internet explorer tarayıcısı açacaktır. Benzer bir konuda yardım arayanlar için bilinmesi gereken bir nokta var, kodları çalıştırmadan önce "Tools > References" Bölümünden "Microsoft İnternet Controls" ve "Microsoft HTML Object Library" Kütüphanelerini aktifleştirmeniz gerekmektedir.

Kod: 
Sub devamsizlik()
    Dim tarayıcı As InternetExplorer
    Dim veri As HTMLLinkElement
    Set tarayıcı = New InternetExplorer
    tarayıcı.navigate "xyz.com"
    Do While tarayıcı.Busy = True Or tarayıcı.readyState <> 4: DoEvents: Loop
    a = tarayıcı.document.getElementsByClassName("text-error")
    Range("A1").Value = a.Text
    tarayıcı.Quit
End Sub
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
PColik' Alıntı:
Merhaba bir alternatif de benden olsun isterim ancak veri alacağınız sitede "text-error" sınıfında birden fazla veri bulunuyorsa istediğiniz veriyi alamamanız mümkündür. Aşağıdaki kodlar arka planda bir internet explorer tarayıcısı açacaktır. Benzer bir konuda yardım arayanlar için bilinmesi gereken bir nokta var, kodları çalıştırmadan önce "Tools > References" Bölümünden "Microsoft İnternet Controls" ve "Microsoft HTML Object Library" Kütüphanelerini aktifleştirmeniz gerekmektedir.

Kod: 
Sub devamsizlik()
    Dim tarayıcı As InternetExplorer
    Dim veri As HTMLLinkElement
    Set tarayıcı = New InternetExplorer
    tarayıcı.navigate "xyz.com"
    Do While tarayıcı.Busy = True Or tarayıcı.readyState <> 4: DoEvents: Loop
    a = tarayıcı.document.getElementsByClassName("text-error")
    Range("A1").Value = a.Text
    tarayıcı.Quit
End Sub
Genişletmek için tıkla ...
Hata benim tam açıklamadıydım. A sütunundaki TC leri sorgulayıp kalan devamsızlıklarını B sütununa yazacak. Kodum aşağıdaki gibidir. mavi olan yeri sizin dediğiniz gibi uyarlamaya çalıştım fakat hata veriyor.




Sub Arama()

Dim ie As Object

Set ie = CreateObject("InternetExplorer.Application")

Application.Wait Now + TimeValue("00:00:02")

ie.Navigate "https://xxxx/xx/yyyy.aspx"

Application.Wait Now + TimeValue("00:00:02")

ie.Width = 1500

ie.Height = 1000

ie.Visible = True

While ie.Busy

DoEvents

Wend

ie.document.getElementById("ctl04_ctlAraTypKayitNo").Value = Range("P1")

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_Search")

ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_Search").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_grvTypListe_ctl02_lnbSec")

ie.document.getElementById("ctl04_grvTypListe_ctl02_lnbSec").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_DevamTakipIslemleri")

ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_DevamTakipIslemleri").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

son = Cells(Rows.Count, "A").End(3).Row

For i = 2 To son

If Cells(i, "A") = "" Then

Cells(i, "B") = "TC YAZ"

Else

ie.document.getElementById("ctl04_ctlTcKimlikNo").Value = Cells(i, "A")

ie.Visible = True

While ie.Busy

DoEvents

Wend



Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Search")

ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Search").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_grvTypCalisanDevamListe_ctl02_lnbSec")

ie.document.getElementById("ctl04_grvTypCalisanDevamListe_ctl02_lnbSec").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Listele")

ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Listele").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend



a = ie.document.getElementsByClassName("text-error")

Cells(i, "B").Value = a.Text



ie.Visible = True

While ie.Busy

DoEvents

Wend

End If

Next

ie.Quit

MsgBox "İŞLEM TAMAMLANMIŞTIR. İYİ ÇALIŞMALAR DİLERİM "

End Sub
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
mancubus' Alıntı:
aşağıdakine benzer bir yöntem ile http://xxx.com/yyy/zzz.php yerine kendi sitenizin adresini yazarak bu değeri döndürdüğünüzü var sayıyorum.
ben bunu xmlhttpMetin adında değişkene atadım.

JSON: 
Sub xlTR_194097()

    Dim xmlhttpMetin As String, rakamMetin As String
    Dim i As Long
    Dim dizi
   
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://xxx.com/yyy/zzz.php", False
        .Send
        xmlhttpMetin = .ResponseText
    End With
   
    dizi = Split(xmlhttpMetin, "Kalan Devamsızlığı: ")
   
    For i = 1 To Len(dizi(1))
        If IsNumeric(Mid(dizi(1), i, 1)) Then
            rakamMetin = rakamMetin & Mid(dizi(1), i, 1)
        Else
            Exit For
        End If
    Next i
   
    MsgBox CLng(rakamMetin)

End Sub
Genişletmek için tıkla ...
İlginiz için çok teşekkür ederim ama ben bunu beni hazırladığım koda uyarlamayı beceremedim. A2 Sütunundan başlayan TC lerin hepsini sorgulayıp B sütününda yani TC sinin karşısına yazmasını istiyorum. Kod aşağıdaki gibi kırmızı renkle yazdığım yer düzeltilecek.

Sub Arama()

Dim ie As Object

Set ie = CreateObject("InternetExplorer.Application")

Application.Wait Now + TimeValue("00:00:02")

ie.Navigate "https://xxxx/xx/yyyy.aspx"

Application.Wait Now + TimeValue("00:00:02")

ie.Width = 1500

ie.Height = 1000

ie.Visible = True

While ie.Busy

DoEvents

Wend

ie.document.getElementById("ctl04_ctlAraTypKayitNo").Value = Range("P1")

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_Search")

ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_Search").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_grvTypListe_ctl02_lnbSec")

ie.document.getElementById("ctl04_grvTypListe_ctl02_lnbSec").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_DevamTakipIslemleri")

ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_DevamTakipIslemleri").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

son = Cells(Rows.Count, "A").End(3).Row

For i = 2 To son

If Cells(i, "A") = "" Then

Cells(i, "B") = "TC YAZ"

Else

ie.document.getElementById("ctl04_ctlTcKimlikNo").Value = Cells(i, "A")

ie.Visible = True

While ie.Busy

DoEvents

Wend



Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Search")

ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Search").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_grvTypCalisanDevamListe_ctl02_lnbSec")

ie.document.getElementById("ctl04_grvTypCalisanDevamListe_ctl02_lnbSec").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Listele")

ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Listele").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend



a = ie.document.getElementsByClassName("text-error")

Cells(i, "B").Value = a.Text



ie.Visible = True

While ie.Busy

DoEvents

Wend

End If

Next

ie.Quit

MsgBox "İŞLEM TAMAMLANMIŞTIR. İYİ ÇALIŞMALAR DİLERİM "

End Sub
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
Haluk' Alıntı:
Alternatif;

C#: 
Sub Test()
'   Haluk - 30/03/2021
'   Referanslar:
'       - Microsoft XML, V6.0
'       - Microsoft HTML Object Library

    Dim HTTP As New XMLHTTP60, HTML As New HTMLDocument
    Dim xElement As Object
   
    URL = ThisWorkbook.Path & "\trt.html"

    HTTP.Open "GET", URL, False
    HTTP.Send
    HTML.body.innerHTML = HTTP.responseText

    Set xElement = HTML.getElementsByClassName("text-error")
   
    If xElement.Length > 0 Then
        MsgBox xElement(0).innerText
    Else
        MsgBox "Kalan Devamsızlık bulunamadı..."
    End If
End Sub
.
Genişletmek için tıkla ...
Haluk bey sizden bugüne kadar çok yardım aldım. hakkınızı helal edin. Ben bunu beni hazırladığım koda uyarlamayı beceremedim. Mancubus'un attığınıda beceremedim. A2 Sütunundan başlayan TC lerin hepsini sorgulayıp B sütününda yani TC sinin karşısına yazmasını istiyorum. Kod aşağıdaki gibi kırmızı renkle yazdığım yer düzeltilecek.

Sub Arama()

Dim ie As Object

Set ie = CreateObject("InternetExplorer.Application")

Application.Wait Now + TimeValue("00:00:02")

ie.Navigate "https://xxxx/xx/yyyy.aspx"

Application.Wait Now + TimeValue("00:00:02")

ie.Width = 1500

ie.Height = 1000

ie.Visible = True

While ie.Busy

DoEvents

Wend

ie.document.getElementById("ctl04_ctlAraTypKayitNo").Value = Range("P1")

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_Search")

ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_Search").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_grvTypListe_ctl02_lnbSec")

ie.document.getElementById("ctl04_grvTypListe_ctl02_lnbSec").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_DevamTakipIslemleri")

ie.document.getElementById("ctl04_ctlCommandTypKayit_CommandItem_DevamTakipIslemleri").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

son = Cells(Rows.Count, "A").End(3).Row

For i = 2 To son

If Cells(i, "A") = "" Then

Cells(i, "B") = "TC YAZ"

Else

ie.document.getElementById("ctl04_ctlTcKimlikNo").Value = Cells(i, "A")

ie.Visible = True

While ie.Busy

DoEvents

Wend



Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Search")

ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Search").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_grvTypCalisanDevamListe_ctl02_lnbSec")

ie.document.getElementById("ctl04_grvTypCalisanDevamListe_ctl02_lnbSec").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend

Set TrackID = ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Listele")

ie.document.getElementById("ctl04_ctlCommandTypCalisanListe_CommandItem_Listele").Click

ie.Visible = True

While ie.Busy

DoEvents

Wend



a = ie.document.getElementsByClassName("text-error")

Cells(i, "B").Value = a.Text



ie.Visible = True

While ie.Busy

DoEvents

Wend

End If

Next

ie.Quit

MsgBox "İŞLEM TAMAMLANMIŞTIR. İYİ ÇALIŞMALAR DİLERİM "

End Sub
 
P

PColik

Katılım
17 Ekim 2011
Mesajlar
31
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Eğer hatayı mavi olan kısımda yani benim söylediğim kısımda alıyorsanız ".Text" yazan yeri ".innerText" olarak değiştirip dener misinz?

Cells(i, "B").Value = a.innerText
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
PColik' Alıntı:
Eğer hatayı mavi olan kısımda yani benim söylediğim kısımda alıyorsanız ".Text" yazan yeri ".innerText" olarak değiştirip dener misinz?

Cells(i, "B").Value = a.innerText
Genişletmek için tıkla ...
Malesef nesne bu özelliği veya yöntemi desteklemiyor hatası alıyorum. Başka bir öneriniz varmı

Run-time error '438': object doesn't support this property or method
 
P

PColik

Katılım
17 Ekim 2011
Mesajlar
31
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Maalesef bağlantı yapmaya çalıştığınız siteye erişemediğimiz için farklı çözümler getiremiyorum. Hatayı tam olarak hangi aşamada aldığınızı belirtebilirseniz belki farklı çözümler önerebiliriz. Mutlaka yardımcı olacak birisi vardır.
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
PColik' Alıntı:
Maalesef bağlantı yapmaya çalıştığınız siteye erişemediğimiz için farklı çözümler getiremiyorum. Hatayı tam olarak hangi aşamada aldığınızı belirtebilirseniz belki farklı çözümler önerebiliriz. Mutlaka yardımcı olacak birisi vardır.
Genişletmek için tıkla ...
a = ie.Document.getElementsByClassName("text-error") buraya kadar sıkıntı yok zaten. f8 ile tek tek gidiyorum tam bu aşamaya gelince hata veriyor.
 
P

PColik

Katılım
17 Ekim 2011
Mesajlar
31
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Kodlarınızın tamamını kopyalayıp örnek bir sitede test etmeye çalıştım. Buraya kadar sıkıntı yok dediğiniz için o alana kadar sadece tanımlamaları yapıp diğer kodları atlayarak geldim, kısacası sadece veri yazdırma işi kalıyor. Bende sınıf ismini değiştirip test ettim ve test ettiğim sitede bir hata vermedi. Acaba bağlandığınız sitede sınıf adında bir yanlışlık olabilir mi? Bunun haricinde ne yazık ki size daha fazla yardımcı olacak fikrim yok.
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
PColik' Alıntı:
Kodlarınızın tamamını kopyalayıp örnek bir sitede test etmeye çalıştım. Buraya kadar sıkıntı yok dediğiniz için o alana kadar sadece tanımlamaları yapıp diğer kodları atlayarak geldim, kısacası sadece veri yazdırma işi kalıyor. Bende sınıf ismini değiştirip test ettim ve test ettiğim sitede bir hata vermedi. Acaba bağlandığınız sitede sınıf adında bir yanlışlık olabilir mi? Bunun haricinde ne yazık ki size daha fazla yardımcı olacak fikrim yok.
Genişletmek için tıkla ...
Mesela kullandığım sitede aynı şekilde bir kaydet tuşu var. Ben o tuşa aşağıdaki kodla click yapabiliyorum. burdan yola çıkarak bir yere varabilirmisiniz.

a = 0
Set Link = IE.Document.getElementsByTagName("a")
For Each l In Link
x = l.innerhtml
y = "Kaydet"
If InStr(1, x, y, vbBinaryCompare) > 0 Then
If a > 0 Then
l.Click
Exit For
End If
a = a + 1 'ikinci kaydete basmak için
End If
Next l
IE.Visible = False
While IE.Busy
DoEvents
Wend
 
P

PColik

Katılım
17 Ekim 2011
Mesajlar
31
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Maalesef bu şekilde yardımcı olamıyorum ya da benim bilgim yetersiz kalıyor. Yardımcı olabilecek arkadaşlar varsa mutlaka yanıt vereceklerdir. Bağlandığınız siteyi Chrome'da açıp incele diyerek çıkan kodları (veriyi çekmek istediğiniz alanın üzerindeyken) bir ekran görüntüsüyle paylaşabilirseniz daha fazla yardımcı olup olamayacağıma bakabilirim. Eğer gözden kaçırdığım bir nokta varsa mutlaka üstatlar konuya cevap vereceklerdir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst