Return first image link from google search in excel using vba

It is possible to modify this code to search for large images and to return the link of the first image. I tryed to modify the google link with the google image link but it doesent work

Sub XMLHTTP()

Dim url As String, lastRow As Long
Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
Dim start_time As Date
Dim end_time As Date

lastRow = Range("A" & Rows.Count).End(xlUp).Row

Dim cookie As String
Dim result_cookie As String

start_time = Time
Debug.Print "start_time:" & start_time

For i = 2 To lastRow

    url = "https://www.google.com/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
    XMLHTTP.send

        Set html = CreateObject("htmlfile")
    html.body.innerHTML = XMLHTTP.ResponseText
    Set objResultDiv = html.getelementbyid("rso")
    Set objH3 = objResultDiv.getelementsbytagname("H3")(0)
    Set link = objH3.getelementsbytagname("a")(0)


    str_text = Replace(link.innerHTML, "<EM>", "")
    str_text = Replace(str_text, "</EM>", "")

    Cells(i, 2) = str_text
    Cells(i, 3) = link.href
    DoEvents
Next

end_time = Time
Debug.Print "end_time:" & end_time

Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
End Sub

hi

check this code

Public Sub Test()
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 = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lastRow
    url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&source=lnms&tbm=isch&sa=X&rnd=1"
    Set IE = New InternetExplorer
    
    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
        If InStr(imgElement.src, sImageSearchString) Then
            If imgElement.ParentNode.nodeName = "A" Then
                Set aElement = imgElement.ParentNode
                
                url2 = imgElement.src
                n = n + 1
            End If
        End If
    Next
    
    Cells(i, 2) = url2
    
IE.Quit
Set IE = Nothing
    End With
Next

End Sub

Cheers!!

Hi,

My earlier code was not fetching first image, use this to fetch..

Requirements In Column A write name of object for which you want image search, In B column you will get URL of source image & in C column you will get Image matching size of your cell, you can re-size your C column to make your image bigger or smaller before running macro..

'Requires additional references to Microsoft Internet Control
'Requires additional HTML object library

Public Sub Fetch_Image()
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
    
lastRow = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lastRow
    url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&source=lnms&tbm=isch&sa=X&rnd=1"
    Set IE = New InternetExplorer
    
    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
        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, 40, furl - 40)
    Cells(i, 2) = furl
    Set m = ActiveSheet.Pictures.Insert(furl)
    With Cells(i, 3)
    t = .Top
    l = .Left
    w = .Width
    h = .Height
    End With
    With m
    .Top = t
    .Left = l
    .ShapeRange.Width = w
    .ShapeRange.Height = h
    End With
    
IE.Quit
Set IE = Nothing
    End With
Next

End Sub

Cheers!!

Hi everyone, thank you very much for your help! the code is great but I get an error

I think the error is due to the format %33%A... of the fetched link: http%3A%2F%2Fweknowyourdreamz.com%2Fimages%2Fbaby%2Fbaby-02.jpg

can you help please?

Originally Posted by Vincent121

Hi everyone, thank you very much for your help! the code is great but I get an error

I think the error is due to the format %33%A... of the fetched link: http%3A%2F%2Fweknowyourdreamz.com%2Fimages%2Fbaby%2Fbaby-02.jpg

can you help please?

i get this same error. even after making sure all references are set.

Originally Posted by jyeldell

i get this same error. even after making sure all references are set.

can you share exact what error you are getting..

Hello All (and thanks ExcelElliot).

Using ExcelElliot's code as is, I received a compile error (even after making sure that all references were set).

It would error out on the line:

Set m = ActiveSheet.Pictures.Insert(furl)

After alot of digging, i discovered that the url passed to the variable "furl" was not getting fully translated into a usable url.....meaning that it contained many instances of "%2F" instead of a forward slash.

I was able to get his code running by adding the following lines of code that further translate the resultant image URL to remove any instances of %2F:

furl = Replace(furl, "%2F", "/")

Hello

When I run excilliot's code it says Compile Error: User-defined type not defined. And it is referring to the "Dim IE as InternetExplorer"

Originally Posted by sawvba

Hello

When I run excilliot's code it says Compile Error: User-defined type not defined. And it is referring to the "Dim IE as InternetExplorer"

Hi
,
You have to set a reference to the IE library for the code to work..

Cheers!!

Alternatively you can remove that line and add following one if you are not sure about howto set references:

Dim IE as Object
Set IE = CreateObject("InternetExplorerer.Application")

Cheers!!

Hi, could anybody assist, i am adding Exelliots code above and i get runtime error 5 , invalid procedure call when i run the code?

when i add values to Column A nothing is happening

Any help would be great! Thanks

im getting the same error.
Any help would be great!

Originally Posted by FDibbins

Did you really not see the post IMMEDIATELY above yours (the very past post you would see as you type your post???

Do you really see me asking a question there ? Don’t be a smart one, if you can help, so be it, otherwise let others reply.

little lost getting a not declared error, anyone have a working workbook to follow?