Extract Picture Links as Text in VBA

[k0023382]

I have been trying to get my ahead around this, however I do not how to use getElementsByClassName to get this done.

For instance, from the link:
www.cvvillas.com/Destinations/Greece/Kefalonia/Villa-Isicos/Villa-Isicos-Gallery

I need to extract the links of the pictures, 14 of them and copy them on cells on Excel
cell A1=> "/CVTravel/media/CVTravel/Destinations/Greece/Kefalonia/Villa%20Isicos/14-min.jpg?width=999&height=667&ext=.jpg"
cell A2=> "/CVTravel/media/CVTravel/Destinations/Greece/Kefalonia/Villa%20Isicos/13-min.jpg?width=999&height=667&ext=.jpg"
etc

I do not need the pictures, just the text under that produces the link.

Maybe there is another way of doing without using getElementsByClassName that it is easier.

Thanks in advance

 

[Haluk]

Try this;

Sub GetLinks()
    Dim HTTP As Object, HTML As Object, URL As String, i As Integer
    
    URL = "http://www.cvvillas.com/Destinations/Greece/Kefalonia/Villa-Isicos/Villa-Isicos-Gallery"

    Set HTML = CreateObject("HTMLFILE")
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    
    HTTP.Open "GET", URL, False
    HTTP.send
    
    HTML.body.innerHTML = HTTP.ResponseText
    
    Set Images = HTML.getElementsByTagName("img")
    i = 0
    
    Do While i < Images.Length
        Range("A" & i + 1) = Images(i).src
        i = i + 1
    Loop
    
    Set HTML = Nothing
    Set HTTP = Nothing

End Sub

 

[Haluk]

For live image links, you better try this;

Sub GetLinks2()
    Dim IE As Object, URL As String, i As Integer
    
    URL = "http://www.cvvillas.com/Destinations/Greece/Kefalonia/Villa-Isicos/Villa-Isicos-Gallery"

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate URL
    
    Do While IE.busy
        DoEvents
    Loop
    Do Until IE.ReadyState = 4
        DoEvents
    Loop
    
    Set Images = IE.Document.getElementsByTagName("img")
    i = 0
    
    Do While i < Images.Length
        Range("A" & i + 1) = Images(i).src
        i = i + 1
    Loop
    
    Set HTML = Nothing
    Set HTTP = Nothing

End Sub

 

[k0023382]

YES. It works like a treat.
Thanks you so much.

 

[Haluk]

You are welcome