获取谷歌图片中第一个结果的图片的 URL

Question

我在一个 excel 文件中有多个关键字，我正在寻找一种方法来获取此 excel 文件中另一个单元格上第一个谷歌图像结果的图像 URL，

举例

如果我的单元格 A1 包含“番茄” 我希望单元格 A2 显示“https://seeds-gallery.com/4963-large_default/novosadski-jabucar-tomato-450-seeds.jpg”，这是显示在 Google 图片上的第一个结果的图片网址

谁能帮帮我

Answer 1

您可以在 VBA 中使用类似以下的方式来做到这一点；

Public Sub InsertPicturesFromWeb()
    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 LastRow As Long
    Dim M, sImageSearchString
    
    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
                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
                
                Call GetShapeFromWeb(Url2, Cells(I, 2))
                
                IE.Quit
                Set IE = Nothing
            End With
        Next I
End Sub

Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
   With rngTarget.Parent
      .Pictures.Insert strShpUrl
      .Shapes(.Shapes.Count).Left = rngTarget.Left
      .Shapes(.Shapes.Count).Top = rngTarget.Top
   End With
End Sub