Вставьте первое изображение, найденное с помощью поиска изображений - PullRequest
0 голосов
/ 03 апреля 2020

Я нашел этот код, который, кажется, работает для других, но я всегда получаю

ошибка выполнения 5, недопустимый вызов процедуры или аргумент

строка ошибки furl = Mid(url2, 40, furl - 40)

макрос должен иметь возможность поиска элементов из столбца a на целом rnet и извлечения 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...