首页 > 解决方案 > 插入通过图像搜索找到的第一张图像

问题描述

我发现该代码似乎对其他人有用,但我总是得到

运行时错误 5,无效的过程调用或参数

错误线furl = Mid(url2, 40, furl - 40)

宏应该能够从互联网上的 a 列中搜索项目,并将图像 url 和图像本身获取到 B、C 列。但我不知道这个有什么问题,如果有人可以帮助我,我将不胜感激如果有另一个代码可以完成这项工作。谢谢你的帮助。

'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
Dim furl As String
    
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)
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

End Sub

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

标签: excelvbaweb-scraping

解决方案


推荐阅读