Open urls from list and scrape only image in link

Subbie

New Member
Joined
May 11, 2019
Messages
32
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:
VBA Code:
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
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
2,147
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
 

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
2,147
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

New Member
Joined
May 11, 2019
Messages
32

ADVERTISEMENT

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

Well-known Member
Joined
Mar 29, 2006
Messages
2,147
I took it easy, but here it is my macro for transforming those urls in picture names:
Code:
 #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

New Member
Joined
May 11, 2019
Messages
32
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
 

Watch MrExcel Video

Forum statistics

Threads
1,130,190
Messages
5,640,749
Members
417,165
Latest member
Hilders1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top