Excel VBA - Problem downloading first image from google (Most fail, others repeat)
Hello, i'm Fex!
This is my first post!
I want to list images in excel based on keywords.
For example, if I have in column A a list of dog breeds, in column B I want the representation of that dog breed in an image format.
I'm FAR from behing an Excel VBA programer, I'm extremely new to this, but I have a lot of programming knowledge in other languages. With this, I searched for many solutions online and glued togueder several VBA scripts to make what I need.
Bellow it's my current code, this one reads the cells that contain the search keywords and fetches the first google image. Problem is most of the times it doesnt download anything and in the end it repeats the same image over and over again. Does anyone have any idea how to fix this, OR have a better way to do this?
Thank you in advace!
Code:
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)
furl = URLDecode(furl)
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
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
https://www.eileenslounge.com/viewtopic.php?f=21&t=40701&p=314836#p314836
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314621#p314621
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314619#p314619
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314600#p314600
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314599#p314599
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314274#p314274
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314229#p314229
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314195#p314195
https://www.eileenslounge.com/viewtopic.php?f=36&t=39706&p=314110#p314110
https://www.eileenslounge.com/viewtopic.php?f=30&t=40597&p=314081#p314081
https://www.eileenslounge.com/viewtopic.php?f=30&t=40597&p=314078#p314078
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314062#p314062
https://www.eileenslounge.com/viewtopic.php?f=30&t=40597&p=314054#p314054
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313971#p313971
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313909#p313909
https://www.eileenslounge.com/viewtopic.php?f=27&t=40574&p=313879#p313879
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313859#p313859
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313855#p313855
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313848#p313848
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313843#p313843
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313792#p313792
https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313771#p313771
https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313767#p313767
https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313746#p313746
https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313744#p313744
https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313741#p313741
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313622#p313622
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313575#p313575
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313573#p313573
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313563#p313563
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313555#p313555
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533
https://www.eileenslounge.com/viewtopic.php?f=39&t=40265&p=313468#p313468
https://www.eileenslounge.com/viewtopic.php?f=42&t=40505&p=313411#p313411
https://www.eileenslounge.com/viewtopic.php?f=32&t=40473&p=313384#p313384
https://www.eileenslounge.com/viewtopic.php?f=30&t=40501&p=313382#p313382
https://www.eileenslounge.com/viewtopic.php?f=30&t=40501&p=313380#p313380
https://www.eileenslounge.com/viewtopic.php?f=30&t=40501&p=313378#p313378
https://www.eileenslounge.com/viewtopic.php?f=32&t=40473&p=313305#p313305
https://www.eileenslounge.com/viewtopic.php?f=44&t=40455&p=313035#p313035
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312889#p312889
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312886#p312886
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312752#p312752
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312734#p312734
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312727#p312727
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312724#p312724
https://www.eileenslounge.com/viewtopic.php?f=44&t=40374&p=312535#p312535
https://www.eileenslounge.com/viewtopic.php?p=312533#p312533
https://www.eileenslounge.com/viewtopic.php?f=44&t=40373&p=312499#p312499
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA