Objeler'e tanımlı linkleri listeleme hk

[Kemal Demir]

Arkadaslar Hepinize Kolay Gelsin.

Aşagıdaki kodda ilgili web sitesinden ilgili bsatır ve sutunlar içerisinden verileri okutabiliyioruz(Forumun katıkılarında dolayı teşekkurler).
Yalnız ilgili sayfa üzerinde objeler'e tanımlı olan linkleri listbox'a aktarmak için yardımcı olabilirmisiniz.

Sub ObjectHyperlinksAddList()
Const url As String = "http://www.bp.com/" 
    Dim sk As Object
    Set sk = CreateObject("internetexplorer.application")
    With sk
        .Visible = True
        .navigate url
    'Buraya nasıl bir kod ilavesi yapılabilir
    'Acılan int sayfasında objelerdeki tanımlı olan linkleri nasıl listeliyebiliriz.
    'ornel "*.gif" , "*.jpg" , "*.bmp"
    End With
    Set ie = Nothing
End Sub

İyi Calismalar.

 

[Recep İpek]

Sadece resim olan ("*.gif" , "*.jpg" , "*.bmp") objelerdeki linklerin adreslerini mi, yoksa sayfadaki tüm (resim+yazı) linklerin adreslerini mi istiyorsunuz?

 

[Kemal Demir]

Çift Kayıt için Özürdilerim.

 

[Kemal Demir]

İyi akşamlar Sn Ripek,

Ben öncelikli olarak objelerı almak istiyorum(Diğerini yapmak için kendim uğraşmak istiyorum).
Örnek "http://www.bp.com/images/bp-logo.gif" ,
"http://www.bp.com/liveassets/bp_internet/globalbp/STAGING/global_assets/images/publications/frontiers/fr19_third_trillion_263x130.jpg"

resme ait tam adresi almak istiyorum.

Teşekkurler.

 

[Recep İpek]

Aşağıdaki kodları boş bir excel sayfasında deneyiniz.

Sub IEIMGLinks()
Dim IE As Object
URL = "[URL="http://www.bp.com/"]www.bp.com[/URL]"
Range("a2:d100").ClearContents
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = False 'True olursa web sayfası görüntülenir.
        .Navigate URL       'Web adresi açılıyor.
                Do Until .ReadyState = 4: DoEvents: Loop
                Do While .Busy: DoEvents: Loop
                i = 2
                For Each objA In IE.Document.Links
                    If UCase(Left(objA.InnerHTML, 4)) = "<IMG" Then
                    Cells(i, "a") = i - 1
                    Cells(i, "b") = "'" & objA.Href
                    Cells(i, "c") = "'" & objA.OuterHTML
                    Cells(i, "d") = "'" & objA.InnerHTML
                    i = i + 1
                    End If
                Next
                Do Until .ReadyState = 4: DoEvents: Loop
                Do While .Busy: DoEvents: Loop
          .Quit
    End With
    Set IE = Nothing
    MsgBox "Bitti"
End Sub

 

[Kemal Demir]

Sevgili Ripek,

Çok Teşekkurler.

İyi Calismalar.