3 Haziran 2014 Salı

Excel ile IMDB'den film bilgileri almak


Merhaba,

Bunun için Brian Fritz tarfından geliştirilmiş olan ve IMDB bilgilerini basitce bir web sayfası mantığıyla sunan www.omdbapi.com sitesinden faydalanacağız. Siteye girdiğinizde çeşitli arama kriterlerinin nasıl kullanıldığını anlatan bir ana sayfa ile karşılacaksınız. Bu yazımda bu kriterleri uzun uzun anlatmayacağım zira yazının konusu bu sayfanın kullanımı değil, bu sayfaya sorgu ve bu sorgu sonucunun alınma işinin Excel ile nasıl yapılacağıdır.
  • Öncelikle boş bir excel dosyası yaratıyoruz. Şayet Excel'de Developer Tab'ınız görünmüyor ise açmak için şu linki inceleyiniz : Show the Developer tab
  • Excel'de bu işlem için XMLHttpRequest nesnesini kullanmamız gerekiyor. 
  • Excel dosyamızın şu şekilde olduğunu varsayalım (Ben basitlik için bu kadar bilgiyi çekeceğim, gelebilecek diğer bilgileri inceleyerek çekebilirsiniz)


  • Kullanımı şu şekilde olacak : A1 hücresine filmin adını yazdıktan sonra "Bul" butonuna basıp kodumuzun film bilgilerini getirmesini bekleyeceğiz. Film bilgileri getirildiğinde Filmin orijinal adı B1, Yapım Yılı C1, IMDB puanı D1 ve Filmin tipi ise E1 hücresine yazılmış olacak. 
  • Bunun için Excel'de şu fonksiyonu kullanabiliriz :
Public Function filmBilgisiGetir(p_film_adi As String) Dim URL As String Dim xml As Object Set xml = CreateObject("MSXML2.XMLHTTP") URL = "http://www.omdbapi.com/?t=" & p_film_adi xml.Open "GET", URL, False xml.Send filmBilgisiGetir = xml.responseText End Function
  • Yukarıda görününen kod bloğunda bir fonksiyon bulunuyor. Bu fonksiyon parametre olarak film adını alıp XMLHttpRequest nesnesi yaratıp verilen URL'ye GET methodu ile bir istekte buluyor. Daha sonra sunucunun vereceği cevabı dinleyip cevabı döndürüyor.  xml.Open "GET", URL, False satırında "GET" sayfaya yapılacak olan isteğin tipi belirtiyor. İki tip istek çeşidi mevcut fakat detaylarına deyinmeyeceğim("GET","POST"). URL ise adından da anlaşılacağı üzere hangi adrese istek yapılacağını belirtmekte. Sonda belirtilen False parametresi ise yapılacak olan isteğin senkron mu asenkronmu olduğunu belirtiyor. Biz burada False yani senkron tipini kullandık. Bu da kodumuzun sayfaya yapılacak olan isteğin cevabını beklemesi gerektiği cevaptan sonra programın ilerlemesini belirtiyor.
Private Sub CommandButton1_Click() filmBul End Sub Public Function filmBilgisiGetir(p_film_adi As String) Dim URL As String Dim xml As Object Set xml = CreateObject("MSXML2.XMLHTTP") URL = "http://www.omdbapi.com/?t=" & p_film_adi xml.Open "GET", URL, False xml.Send filmBilgisiGetir = xml.responseText End Function Public Sub filmBul() For i = 2 To 65535 If Range("A" & i).Value = "" Then Exit For End If parseText i, filmBilgisiGetir(Range("A" & i).Value) Next i End Sub Public Function cleanStr(a) Dim b As String b = Replace(a, "}", "") b = Replace(b, "{", "") b = Replace(b, """", "") cleanStr = b End Function Sub parseText(i, text) infoCouple = Split(text, """,") For k = 0 To UBound(infoCouple) - 1 info = Split(infoCouple(k), ":") infoKey = cleanStr(info(0)) infoValue = cleanStr(info(1)) If infoKey = "Title" Then Range("B" & i).Value = infoValue ElseIf infoKey = "Year" Then Range("C" & i).Value = infoValue ElseIf infoKey = "imdbRating" Then Range("D" & i).Value = infoValue ElseIf infoKey = "Genre" Then Range("E" & i).Value = infoValue End If Next k End Sub
  • Üstteki koddan ve ekran görüntüsünden de anlaşılacağı üzere gerekli bilgileri alıp gerekli hücrelerin içerisinde yazdırıyoruz. Ben bir döngü yardımıyla 65536 adet satırın içerisinde boş kayıt bulana kadar döndürüp birden fazla filmin özelliklerine çekmek için kodu düzenledim. Siz de kendinize göre istediğiniz şekilde kodu değiştirip taklalar attırabilirsiniz.
  • Dosyanın tam haline ulaşmak için tıklayın.

7 yorum:

  1. kodu kullandım calısıyor bı sorun yok ama

    a3 bos a4 fılm adı a5 bos a6 fılm adı var dıyelım

    boslukları atlayıp a4 ve a6 ya ımdb nasıl sorgularız yardımcı olabılırmısınız ?

    YanıtlaSil
    Yanıtlar
    1. Public Sub filmBul() kısmını şu şekilde değiştirmek gerekir.

      Public Sub filmBul()
      For i = 2 To 65535
      If Range("A" & i).Value <> "" Then
      parseText i, filmBilgisiGetir(Range("A" & i).Value)
      End If
      Next i
      End Sub

      Sil
  2. dedıklerınızı yapdım calısıyor fakat lıstenın yarısına kadar yapıp gerı kalanını yapmıyor hata verıyor debug yapdıgım zaman sarı renklı satırda hata gosterıyor

    http://i.hizliresim.com/MPvl12.jpg

    YanıtlaSil
    Yanıtlar
    1. exceldeki tablo bu şekilde

      yarıda kalıyor

      http://i.hizliresim.com/LYno61.jpg

      Sil
    2. Evet bu hatayı bende alıyorum... nedir çözümü acaba?

      Sil
  3. Türke Altayazı gibi sitelerden film özetini de çekebilir miyiz ?

    YanıtlaSil