Я нашел этот код, который, кажется, работает для других, но я всегда получаю
ошибка выполнения 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