Code does not Extract the Images from some URL - excel

Question

I have been using this code which works for some URL but not for all I really do not why. Then I have tried with different available codes online but no success.
Your help will be really appreciated in this regards.
Option Explicit
Dim rng As Range
Dim cell As Range
Dim Filename As String
Sub URLPictureInsert()
Dim theShape As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set rng = ActiveSheet.Range("A1:A3000") ' <---- ADJUST THIS
For Each cell In rng
Filename = cell
If InStr(UCase(Filename), "JPG") > 0 Then ' <--- USES JPG ONLY
ActiveSheet.Pictures.Insert(Filename).Select
Set theShape = Selection.ShapeRange.Item(1)
If theShape Is Nothing Then GoTo isnill
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
With theShape
.LockAspectRatio = msoFalse
.Width = 20
.Height = 20
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
isnill:
Set theShape = Nothing
Range("A2").Select
End If
Next
Application.ScreenUpdating = True
Debug.Print "Done " & Now
End Sub
URL's
https://s3-eu-west-1.amazonaws.com/images.linnlive.com/a93f20bbb3640a1a7dc9b9a05bee8540/fc310885-cd82-49cb-bc7a-aabd08531517.jpg
https://s3-eu-west-1.amazonaws.com/images.linnlive.com/a93f20bbb3640a1a7dc9b9a05bee8540/c6c7a645-8273-40ee-87e5-1dd385111a28.jpg
https://s3-eu-west-1.amazonaws.com/images.linnlive.com/a93f20bbb3640a1a7dc9b9a05bee8540/cf9f971b-6af6-4894-a2d5-c58681adb466.jpg

Answer 1

Try this code below, it will Debug.Print the URL that fails to insert. Adapt to your need (if any)
Sub URLPictureInsert()
Dim rng As Range
Dim cell As Range
Application.ScreenUpdating = False
With ActiveSheet
Set rng = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row) ' <---- ADJUST THIS
End With
For Each cell In rng
If InStr(UCase(cell), "JPG") > 0 Then '<--- ONLY USES JPG'S
With cell.Offset(0, 1)
On Error Resume Next
ActiveSheet.Shapes.AddPicture cell, msoFalse, msoTrue, .Left + (.Width - 10) / 2, .Top + (.Height - 10) / 2, 20, 20
If Err.Number = 1004 Then Debug.Print "File not found: " & cell
On Error GoTo 0
End With
End If
Next
Application.ScreenUpdating = True
Debug.Print "Done " & Now
End Sub

Answer 2

You will need to use On Error Resume Next, but only for the single statement that inserts the picture. And you should get rid of the Select. The Pictures.Insert-method returns the reference to the inserted image, assign this to a variable and work with that.
Additionally, I would suggest to split your code and create a routine that insert one image into a cell. Call this routine from the loop. I have implemented it as a function that returns True if it was successfull, it's up to you to decide if you want to do something if it returns False.
Function TryInsertImg(filename As String, cell As Range) As Boolean
Dim p As Picture
On Error Resume Next
Set p = cell.Parent.Pictures.Insert(filename)
If Err.Number > 0 Then Debug.Print "Couldn't insert image " & Err.Number & "-" & Err.Description
On Error GoTo 0
If p Is Nothing Then
Exit Function
End If
Dim theShape As Shape
Set theShape = p.ShapeRange.Item(1)
With theShape
.LockAspectRatio = msoFalse
.Width = 20
.Height = 20
.Top = cell.Top + (cell.Height - .Height) / 2
.Left = cell.Left + (cell.Width - .Width) / 2
End With
TryInsertImg = True
End Function
Your calling routine could look like this:
For Each cell In rng
Filename = cell
If InStr(UCase(Filename), "JPG") > 0 Then '<--- ONLY USES JPG'S
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
If Not TryInsertImg(filename, xRg) then
xRg = "(error loading image)"
End If
End If
Next cell