Webden veri çekme

Hemen belirtmek isterim ki, bu yöntemi uygulamak için biraz da olsa Html ve javascript(bazen de css) bilgisi gereklidir. Bunlara aşina değilseniz uygun bir tutorial sitesinden(w3school olabilir) temelleri almanızda fayda var.

Web'den tüm bir sayfa içeriğini VBA ile alabilmeniz mümkün olsa da biz bu sitede daha çok verilerle ilgilendiğimiz için veri okumayla ilgili kısma yoğunlaşacağız. Verilerin bulunduğu HTML elemanları da büyük çoğunlukla table elemanları içinde bulunmaktadır.

Lafı uzatmadan hemen örneğimize geçelim. Diyelim ki aşağıdaki sitede(https://kur.doviz.com/) bulunan döviz tablosunu Excel içine almak istiyoruz.

Şimdi bu noktada ilk yapmamız gereken tabloda bir yere gelip sağ tıklamak ve "İncele" demek olacaktır.

Bunu yaptığımızda browser penceremizde bir bölme açılır ve seçtiğimiz kısma konumlanarak onun elemanlarını bize gösterir.

Bu kısmı biraz kurcalarsak thead ve tbody kısımlarını görürüz. thead kısmında ilgili listenin başlıkları yazmakta. tbody kısmında ise veriler bulunmakta.(Daha geniş bir görüntüyü, sağ tıkladıktan sonra İncele yerine Sayfa kaynağını görüntüle seçeneği ile görebilirsiniz)

Gördüğünüz üzere, bizim hedef kitlemiz "hisse-tablo" class'ına sahip olan "tr" tag'leri. Yanız thead içinde de hisse-tablo var bi tane(her ne kadar tam class adı "hisse-tablo hisse-tablo-row1" görünse de). Dolayısıyla biz ilk "hisse-tablo" class'lı elemanı değil sonrasındakilere bakmalıyız.

Şimdi üstteki resimlerden belli olmadığı için tüm sayfa kaynağından bakacak olursak, bu tr tag'inin açılmış halini daha açıkça görebiiriz. Bunların içinde aşağıdaki gibi td taglerini görüyoruz. Bizim ihtiyacmız olan bunlardan döviz adı, alış ve satış fiyatları; yani sırayla 1, 4, ve 5. elemanlar. Javascriptte indexler 0'dan başladığı için  0, 3 ve 4. elemanlar. Bu td elemanları tr elemanlarının bir alt seviyesi olduğu için bunlara tr'nin çocukları denir, yani children özelliği ile bunlara ulaşılabilir.

Şimdi kod yazımı için hazırlığımızı yapalım.

Kurgumuz aşağıdaki gibi olacak. B1 hücresinden döviz kurlarının kaynağını seçeceğiz.(Serbest piyasa mı yoksa başka bir kurumun fiyat bilgileri mi diye). Buna göre dönen sonuç A5-C5 range'inden aşağıya doğru gelecek. Yani bir worksheet_change event'i sözkonusu.

İlk olarak bir dictionary'ye ihtiyacımız olacak. Bunu B1'den seçilen değerin karşılığı olarak Url'ye bir ek yapmak için kullanacağız. Örneğin B1'de kaynak olarak "Serbest Piyasa" seçilirse url eki Serbest-Piyasa oluyor. Bunun için global geçerli olması gereken bir dict değişkenini Module1 içinde tanımladım. Buna hem workbook_open eventinden hem de worksheet_change eventi içinde erişeceğiz. Workbook_open içinden dictionary'yi dolduruyoruz ve B1 hücresine data validation yapıyoruz.

'Module1 içeriği
Public dict As New Scripting.Dictionary

'ThisWorkbook içeriği
Private Sub Workbook_Open()

dict.Add "Serbest Piyasa", "Serbest-Piyasa"
dict.Add "Akbank", "Akbank"
dict.Add "Denizbank", "Denizbank"
dict.Add "Merkez Bankası", "Merkez-Bankasi"

For Each k In dict.Keys
    liste = liste & "," & k
Next k

    With Range("b1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Mid(liste, 2, Len(liste) - 1)
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Kodun bundan sonraki kısmı iki ayrı yöntemle yapılabilir. İlk olarak Internet Explorer yöntemini kullanıcaz, sonra da HTTP yöntemini.

IE ile kod yazmı

Bunun için Internet Explorer'ın(IE) bir örneğini yaratıcaz, bunu gerçekten açmıyoruz tabi, sadece bellekte açıyoruz. O yüzden IE'nin nesne modeline ihtiyacımız var. (Bu yöntem için PC'nizde IE olması gerektiği aşikar.)

Ayrıca HTML elemanları ile çalışacağımız için HTML nesne modeline de ihtiyacımız bulunuyor.

Bunları eklemek için Tools>Reference üzerinden aşağıdaki libraryler eklenir:

Worksheet_change eventinin kodu da aşağıdaki gibi olacaktır. Kod içinde gerekli tüm açıklamalar bulunmakta.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim IE As InternetExplorer
Dim elements As IHTMLElementCollection 'birçok tr tagini tutacak olan html collectionımız
Dim url As String
Dim url_ek As String
Dim r As Integer

On Error GoTo hata
If Not Target.Address = "$B$1" Then Exit Sub 'sadece B1'e tıklanırsa ektif olsun
Application.EnableEvents = False 'data çekilirken recursive şekilde tetiklenme olmasın diye eventleri geçici olarak pasifleştiriyoruz

Application.StatusBar = "Lütfen bekleyiniz..."
url_ek = dict([B1].Value)
[b2].ClearContents

başlangıç = Timer 'süre ölçmek istersek diye koydum

'önce eski veriyi temizleyelim
Range("Table1").Select
Selection.ClearContents

Set IE = New InternetExplorer
IE.Visible = False
url = "https://kur.doviz.com/" & url_ek
IE.navigate url 'ilgili sayfayı bellekte açıyoruz

'Bu kısım önemli, IE'yi bellekte açar açmaz sayfa yüklemesi hemen olmaz
Do While IE.Busy Or IE.READYSTATE <> 4 'sayfa yüklememsi tamamlanana kadar bekliyoruz
    DoEvents
Loop

Application.StatusBar = "Veri Çekiliyor..." 'veri çekilmeye başlandığında statusbarı güncelliyoruz
Set elements = IE.document.getElementsByClassName("hisse-tablo") 'classı "hisse-tablo" olan tüm elemanları elements değişkenine atıyoruz
'Application.Wait (Now + TimeValue("00:00:05")) 'eğer eksik veri geliyorsa tam olarak belleğe alamıyordur, bunun için gereken süre kadar bekleriz, burayı duruma göre sizin ayarlamanız gerekecek
r = 5 'başlangıç satırı

For i = 1 To elements.Length - 1 '0'dan değil 1den başlıyoruz, çünkü başlığın olduğu kısmı atlıyoruz
    If elements(i).ID = "linkUnit" Then GoTo atla 'RUS rublesindeki sonraki çizgiyi atlıyoruz

    Cells(r, 1).Value = elements(i).Children(0).innerText 'döviz adı, 0 indeksli yani 1. eleman
    'Küsuratlarda problem çıkmaması için virgülleri nokta ile replace ediyoruz
    Cells(r, 2).Value = Replace(elements(i).Children(3).innerText, ",", ".") 'alış fiyatı 3 indeksi yani 4.eleman
    Cells(r, 3).Value = Replace(elements(i).Children(4).innerText, ",", ".") 'Satış fiyatı 4 indeksi yani 5.eleman
    r = r + 1
atla:
Next i

bitiş = Timer
Debug.Print bitiş - başlangıç 'geçen süreyi yazdırıyoruz
IE.Quit 'ilgili sayfada reklam v.s varsa arka planada müzik çalmaya devam eder, bu satırla arka planda açık olan Internet Exlporer'dan çıkarız ve reklam müziği sona erer
Set IE = Nothing: Set htmldoc = Nothing: Set elements = Nothing 'ilgili objeleri bellekten atıyoruz

Range("Table1[[Alış]:[Satış]]").Select
Selection.NumberFormat = "0.00"
    
[lastruntime].Value = Now 'güncelleme zamanını yazıyoruz
[lastruntime].Select

Application.StatusBar = "İşlem tamam"
Application.EnableEvents = True 'Enableevent özelliğini tekrar aktive ediyoruz
Exit Sub

hata:
    Set IE = Nothing: Set htmldoc = Nothing: Set elements = Nothing
    Application.StatusBar = ""
    MsgBox "Bi hata oluştu" + Err.Description
    Application.EnableEvents = True
    
End Sub	

For Next döngüsünü aşağıdaki gibi de yapabilirdik, ancak bu sefer ilk If kontrolünü tüm döngü boyunca yapmak durumunda kalırdık, ki bu da performansı yoran bir işlem olurdu, o yüzden yukarıdaki yöntem daha hızlıdır. Ama bu tür kontrollerin gerekmediği durumlarda For Each döngüleri daha pratik olmaktadır.

'En başta da şu tanım yapılmalıdır
Dim element As IHTMLElement

For Each element In elements
    If element.className = "hisse-tablo hisse-tablo-row1" Then GoTo atla 'başlığın olduğu kısmı atlıyoruz
    If element.ID = "linkUnit" Then GoTo atla 'RUS rublesindeki sonraki çizgiyi atlıyoruz

    Cells(r, 1).Value = element.Children(0).innerText 'döviz adı, 0 indeksli yani 1. eleman
    Cells(r, 2).Value = Replace(element.Children(3).innerText, ",", ".") 'alış fiyatı 3 indeksi yani 4.eleman
    Cells(r, 3).Value = Replace(element.Children(4).innerText, ",", ".") 'Satış fiyatı 4 indeksi yani 5.eleman
    r = r + 1
atla:
Next element

Gördüğünüz üzere, html elemanlarını parse ederken çeşitli metodlar ve özellikler kullanırız. Bunlar özetle aşağıdaki gibi olup özellikle bunları araştırmanız ve öğrenmenizi tavsiye ederim.

• getElementsByTagName: Çok elemandan oluşan bir  IHTMLElementCollection collection'ı döndürür

• getElementsByClassName: Çok elemandan oluşan bir  IHTMLElementCollection collection'ı döndürür

• getElementById: Tek bir IHTMLElement elemanı döndürür

• innerText: İlgili elemanın içindeki metini verir.

• innerHTML: İlgili elemanın tüm HTML metnini verir.

• textContent: İlgili elemanın içindeki <span> v.s elemanları kapsayacak şekilde metnini verir.

NOT:Unutmayın ki, web siteleri zamanla değişebilir. Bu nedenle kodunuzda zaman zaman güncelleme yapmanız gerekebilir.

2.Örnek

Şimdi ise, konuyu pekiştirmek adına ve değişme ihtimali çok düşük bir sayfadan veri çekeceğiz. Değişme ihtimalinin çok düşük olması sayfanın benim web sitemdeki bir sayfa olmasından. Olur da bir değişiklik yaparsam bu çok büyük ihtimalle “class” isminde olacaktır.

Hemen örneğimize geçelim.

Veri çekeceğimiz tablo ve html görüntüsü aşağıdaki gibidir.

Buna göre kodlarımız şöyle olacaktır. Tüm açıklamaları kod içinde bulabilirsiniz.

Sub webdenveri()
 
Dim IE As InternetExplorer
Dim tablolar As IHTMLElementCollection 'tablolarımızın ID'si yok, classı var, class olması demek 1den çok tablo olabilir demek,
'bu sayfamızda 1 tablo var gerçi, ama biz yine de bu şekilde ilerlemek durumundayız
Dim tbody As IHTMLElement 'tablodaki tbody elementini tutacak
Dim r As Integer
 
On Error GoTo hata
 
Set IE = New InternetExplorer
IE.Visible = False
url = "https://www.excelinefendisi.com/Konular/Excel/Giris_PratikKisayollar.aspx"
IE.navigate url 'ilgili sayfayı bellekte açıyoruz
 
'Bu kısım önemli, IE'yi bellekte açar açmaz sayfa yüklemesi hemen olmaz
Do While IE.Busy Or IE.READYSTATE <> 4 'sayfa yüklememsi tamamlanana kadar bekliyoruz
    DoEvents
Loop
 
Set tablolar = IE.document.getElementsByClassName("alterantelitable") 'classı "alterantelitable" olan tüm tabloları tablolar değişkenine atıyoruz, 1 tane var zaten
'Application.Wait (Now + TimeValue("00:00:05")) 'eğer eksik veri geliyorsa tam olarak belleğe alamıyordur, bunun için gereken süre kadar bekleriz, burayı duruma göre sizin ayarlamanız gerekecek
r = 1 'başlangıç satırı
Set tbody = tablolar(0).Children(0) 'ilk tablonun(her ne kadar 1 tane olsa da) ilk elementi, yani tbody
For i = 0 To tbody.Children.Length - 1 'tbody altındaki tüm child elementlar kadar, yani tr tagleri kadar, özetle tüm satırlarda döneceğiz
    Cells(r, 1).Value = tbody.Children(i).Children(0).innerText 'tbodynin ilk satırının ilk child elemanı, yani ilk td'si, yani ilk kolonu(ilk satır için td değil, th ama bizim için değişen birşey yok)
    Cells(r, 2).Value = tbody.Children(i).Children(1).innerText 'tbodynin ilk satırının ikinci child elemanı, yani ikinci td'si, yani ikinci kolonu
     r = r + 1
Next i
 
IE.Quit 'ilgili sayfada reklam v.s varsa arka planada müzik çalmaya devam eder, bu satırla arka planda açık olan Internet Exlporer'dan çıkarız ve reklam müziği sona erer
Set IE = Nothing: Set tablolar = Nothing: Set tbody = Nothing 'ilgili objeleri bellekten atıyoruz
Exit Sub
 
hata:
    Set IE = Nothing: Set tablolar = Nothing: Set tbody = Nothing
    MsgBox "Bi hata oluştu, " + Err.Description
  
End Sub

Sonuç aşağıdaki gibi olacaktır.

Gerekli formatlama işlerini size bırakıyorum.

Http yöntemi

Yakında...