Open urls from list and scrape only image in link

[Subbie]

Hi
I am returning to the forum after a long absence. I no longer use excel regularly now I am retired.
I am researching genealogy and need to scrape a list of images (Plus 2000) I have listed them in a column (A) in excel and have tried a number of solutions from the web, the latest being:

Sub URLPictureInsert()
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("A1:A3")
For Each cell In Rng
filenam = cell
ActiveSheet.Pictures.Insert(filenam).Select
Set Pshp = Selection.ShapeRange.Item(1)
If Pshp Is Nothing Then GoTo lab
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
If .Width > xRg.Width Then .Width = xRg.Width * 2 / 3
If .Height > xRg.Height Then .Height = xRg.Height * 2 / 3
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("A2").Select
Next
Application.ScreenUpdating = True
End Sub

This is the one that got me closest. However, all it does is insert a rectangle shape in column B but no image.
An example of the link I am using is Genealogy Image.

This forum has always been very helpful and I hope that someone might come to my rescue. Appreciate any help given.

Martin

 

[Anthony47]

Could you please specify which is the content of cells A1:A3?

Bye

 

[Subbie]

Hi Anthony
Thanks for responding.
The cells contain urls similar to the one in my post.

Szabina of Hungary,Moritz Family Chart

Image of Szabina of Hungary,.

www.wikitree.com

Martin

 

[Anthony47]

I need the url, what has been attached could be interpreted in more that one mode; the exact string contained in A3, for example.

Bye

 

[Subbie]

Sorry Anthony,
Thed link that is in the cell is;
"

https://www.WikiTree.com/wiki/Image:Bigod-1.png"

 

[Anthony47]

That is the address of the web page, the address of that picture is https://www.wikitree.com/photo.php/6/6e/Bigod-1.png
Are all the urls in that same format? If Yes then I shall try to convert all of them.

Bye

 

[Subbie]

Ah right Anthony.. I see. Yes the links in Col. A are all the same type i.e. the web page..so I guess that would mean a code to convert them first and then download them?
Thanks for your assistance.

 

[Anthony47]

I took it easy, but here it is my macro for transforming those urls in picture names:

 #If VBA7 Then       '!!! ON  TOP  OF  THE  VBA  MODULE   !!!!
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub GetCoAPict()
'Dim IE As MSHTML, AColl As IHTMLElementCollection
Dim IE As Object, AColl As Object, I As Long, myItm As Object
Dim JJ As Long, FreeCol As String, myUrl As String, BaseAdd As String
'
FreeCol = "B"           '<<< A free Column to hold the picture names
'
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
BaseAdd = "https://www.wikitree.com"
'
For JJ = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    myUrl = Cells(JJ, "A")
    '        https://www.wikitree.com/photo.php/6/6e/Bigod-1.png
    With IE
        .navigate myUrl
        Sleep 100
        Do While .Busy: DoEvents: Sleep (30): Loop  'Attesa not busy
        Do While .readyState <> 4: DoEvents: Sleep (30): Loop 'Attesa documento
    End With
    For I = 1 To 6          'Wait for image div
        Sleep 300
        Set AColl = IE.document.getElementsByClassName("nine")
        If AColl.Length = 1 Then Exit For
    Next I
    If I < 6 Then           'if not TimeOut:
        Set myItm = AColl(0).getElementsByTagName("img")(0)
        Cells(JJ, FreeCol).Value = BaseAdd & myItm.getAttribute("src")
    End If
Next JJ
IE.Quit
Set IE = Nothing
End Sub

The code has to be copied into an empty vba standard module, so that the initial declare is on top of the module.
The line marked <<< need to be compiled with the name of a free column that will be used to hold the pictures names
The macro deals with www.wikitree.com , for what I can see starting from your sample url
Other sites shall return blank pictures names

Try…

 

[Subbie]

Brilliant Anthony..it puts the urls for the actual image location in Column C..is there a way to add code to download the actual picrures in to a file?
Thanks so much for what you have done, it's great!
Martin

 

[Anthony47]

Do you mean "saving the pictures to your local disc"?