Use excel to search image on google and insert link of first image found

Hi,

Making project where you need to download tens of hundreds of images from web & tired of googling around..Here comes the solution using Excel VBA Macro.

In column A insert name of objects to be download & in Column B you will get URL of Image & in Column C you will get Image of the same size of your cell.

Click to Download


Source Code:

'Requires additional references to Microsoft Internet Control

'Requires additional HTML object library

Public Function URLDecode(url$) As String
    With CreateObject("ScriptControl")
        .Language = "JavaScript"
        URLDecode = .Eval("unescape(""" & url & """)")
    End With
End Function

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, furl 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

  
    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

              

                If n = 2 Then

                url2 = aElement.href

                url3 = imgElement.src

                GoTo done:

                End If

                n = n + 1

                End If

        End If

    Next

done:

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

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

furl = URLDecode(furl)


    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



MsgBox "Done!!"

End Sub

Cheers!!