We could get better results by first downloading the image and then inserting (Note***) it into the worksheet.
So let's modify the code for the Sub InsertPicturesFromWeb this way:
Code:
Public Sub InsertPicturesFromWeb()
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim I As Integer
Dim URL As String, Url2 As String
Dim LastRow As Long
Dim oObj As Object, nPicName
'
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Set IE = New InternetExplorer
For I = 1 To LastRow
URL = "https://www.babyshopstores.com/ae/en/p/" & Cells(I, 1)
With IE
.Visible = True
.Navigate URL
Do While .Busy: DoEvents: Loop 'wait not busy, ADD
Do Until .readyState = 4: DoEvents: Loop
Set HTMLdoc = .document
Set oObj = HTMLdoc.getElementById("thmb-01")
Url2 = oObj.src
nPicName = GetWebFile(Url2, "C:\PROVA\")
If nPicName <> 0 Then
With ActiveSheet
.Pictures.Insert nPicName
.Shapes(.Shapes.Count).Left = Cells(I, 2).Left
.Shapes(.Shapes.Count).Top = Cells(I, 2).Top
End With
End If
End With
Next I
IE.Quit
Set IE = Nothing
End Sub
The line marked <<< need to be customized with a valid path to your disc; the images will be downloaded there.
This new version does no longer require the Sub GetShapeFromWeb, that can be deleted; but require this new Function GetWebFile:
Code:
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Function GetWebFile(ByVal myURL, ByVal myPath As String) As Variant
'byAnthony, ritorna Image Path & name OPPURE 0 se fail
Dim PathNName As String, URL As String
Dim mySplit, Resp As Long
mySplit = Split(myURL, "/")
PathNName = myPath & mySplit(UBound(mySplit))
Resp = URLDownloadToFile(0, myURL, PathNName, 0, 0)
If Resp = 0 Then
GetWebFile = PathNName
Exit Function
Else
GetWebFile = 0
End If
End Function
Beware that the initial declaration has to be put ON TOP of the vba module, before any other Sub or Function; so my suggestion is that you copy this second block of code into a new, just created, vba module.
***Note that Pictures.Insert set a LINK to the image, does not embed the images themselves into the workbook; in case you plan sharing the file with someone else the images will not be visible.
If this is your situation then we will use Shapes.AddPicture: this will make your file "fatter" as the images travel with the file.
Bye
