Insert first image into found on a search engine based on a keyword

Im trying to find a script that inserts the first image based on a keyword i.e. A1 "Abelia chinensis Variegata" finds a picture of the plant and puts it in B1

i have found the script below taken from a previous thread https://www.excelforum.com/excel-pro...from-cell.html

but i get

Althought the keyword is column D the results in A are almost all zeros

So unable to check if this does what i need it to.

Any help would be greatly appreciated.

Althought the keyword is column D the results in A are almost all zeros

So unable to check if this does what i need it to.

Any help would be greatly appreciated.

'Requires additional references to Microsoft Internet Control
'Requires additional HTML object library
Public Sub imagedownload()
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim imgElements As IHTMLElementCollection
Dim imgElement As HTMLImg
Dim aElement As HTMLAnchorElement
Dim n As Integer, I As Integer
Dim Url As String, url2 As String
Dim m, LastRow As Long
Dim furl As String

Sheets("one").Select

LastRow = Range("D" & Rows.Count).End(xlUp).Row

For I = 3 To LastRow

Url = "https://www.google.com/search?q=" & Cells(I, 4) & "&source=lnms&tbm=isch&sa=X&rnd=1"
Set IE = New InternetExplorer
On Error Resume Next

Sheets("one").Select
With IE
.Visible = False
.navigate Url 'sWebSiteURL

Do Until .readyState = 4: DoEvents: Loop
'Do Until IE.document.readyState = "complete": DoEvents: Loop

Set HTMLdoc = .document

Set imgElements = HTMLdoc.getElementsByTagName("IMG")

n = 1
For Each imgElement In imgElements
On Error Resume Next


If InStr(imgElement.src, sImageSearchString) Then
If imgElement.ParentNode.nodeName = "A" Then
Set aElement = imgElement.ParentNode
'Cells(n, 2).Value = imgElement.src
'Cells(n, 3).Value = aElement.href
If n = 2 Then
url2 = aElement.href 'imgElement.src
url3 = imgElement.src 'aElement.href
GoTo done:
End If

n = n + 1

End If
End If
Next

done:
furl = InStrRev(url2, "&imgrefurl=", -1)

furl = Mid(url2, 37, furl - 37)



Sheets("two").Select

'On Error Resume Next
Cells(I, 1) = furl
Set m = ActiveSheet.Pictures.Insert(furl)
With Cells(I, 1)
t = .Top
l = .Left
w = .Width
h = .Height
End With
With m
.Top = t
.Left = l
.ShapeRange.Width = w
.ShapeRange.Height = h
End With

Sheets("one").Select

IE.Quit
Set IE = Nothing
End With
Next

End Sub