我正在尝试从下面两个网站中抓取数据。
两个网站都具有从中提取数据的相同结构和场所模式。我可以从一个网站成功提取数据,但是在抓取第二个网站时显示错误。
错误:无效的过程调用或参数
错误调试突出显示了代码的第137行
aa = Mid(xr,b1 + 12,aa2-b1)
。请检查一下。谢谢
Sub noondata()
'Application.ScreenUpdating = False
'
Dim oHtml As HTMLDocument
Dim oElement As Object
Set oHtml = New HTMLDocument
'Sheets("Item List").Columns("A:A").ClearContents
fromm = Sheets("Item Details").Cells(2, 19)
too = Sheets("Item Details").Cells(2, 21)
kk = Sheets("Item Details").Cells(Rows.Count, 10).End(xlUp).Row
For kkk = fromm To too
URL = Sheets("Item List").Cells(kkk, 1)
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
.Open "GET", URL, False
.send
oHtml.body.innerHTML = .responseText
End With
'Set oElement = oHtml.getElementsByClassName("jsx-3598356079")
Set oElement = oHtml.getElementsByClassName("jsx-3598356079 notAvailableNote")
If oElement.Length = 1 Then
Set oElement = oHtml.getElementsByTagName("h1")
Sheets("Item Details").Cells(kk + 1, 1) = oElement(0).innerText
Sheets("Item Details").Cells(kk + 1, 2) = "Sorry! This product is not available."
Sheets("Item Details").Cells(kk + 1, 3) = "Sorry! This product is not available."
Sheets("Item Details").Cells(kk + 1, 4) = "Sorry! This product is not available."
Else
Set oElement = oHtml.getElementsByClassName("jsx-3598356079 brand")
Sheets("Item Details").Cells(kk + 1, 2) = oElement(0).innerText
'jsx-3598356079
Set oElement = oHtml.getElementsByClassName("jsx-3598356079")
Sheets("Item Details").Cells(kk + 1, 3) = oElement(2).innerText
Set oElement = oHtml.getElementsByClassName("jsx-3799960900 sellingPrice")
Sheets("Item Details").Cells(kk + 1, 4) = oElement(0).innerText
Set oElement = oHtml.getElementsByClassName("jsx-1312782570")
If oElement.Length > 0 Then
Sheets("Item Details").Cells(kk + 1, 5) = Right(oElement(1).innerText, Len(oElement(1).innerText) - 2)
End If
Set oElement = oHtml.getElementsByClassName("jsx-3598356079")
If oElement.Length > 0 Then
Sheets("Item Details").Cells(kk + 1, 6) = "Yes"
Else
Sheets("Item Details").Cells(kk + 1, 6) = "No"
End If
Set oElement = oHtml.getElementsByClassName("jsx-1312782570")
If oElement.Length > 0 Then
Sheets("Item Details").Cells(kk + 1, 12) = Right(oElement(13).innerText, Len(oElement(13).innerText) - 10)
Sheets("Item Details").Cells(kk + 1, 13) = Right(oElement(10).innerText, Len(oElement(10).innerText) - 11)
Else
Set oElement = oHtml.getElementsByClassName("jsx-1393259234")
Sheets("Item Details").Cells(kk + 1, 12) = oElement(1).innerText 'Right(oElement(13).innerText, Len(oElement(13).innerText) - 10)
Sheets("Item Details").Cells(kk + 1, 13) = Right(oElement(5).innerText, Len(oElement(5).innerText) - 7)
End If
Set oElement = oHtml.getElementsByTagName("img")
For bb = 9 To 12 'oElement.Length
Sheets("Item Details").Cells(kk + 1, 5 + bb) = oElement(bb - 1).src
Rows(kk + bb + 2 & ":" & kk + bb + 2).RowHeight = 20
Next bb
'var start
Set oElement = oHtml.getElementById("__NEXT_DATA__")
xx = oElement.innerHTML
xf = InStr(1, xx, "groups"":[", vbTextCompare)
xf1 = Len(xx) - (xf + 10)
xr = Right(xx, xf1)
aa1 = InStr(1, xr, "[", vbTextCompare)
aa2 = InStr(aa1 + 1, xr, "[", vbTextCompare)
b1 = InStr(1, xr, "]", vbTextCompare)
b2 = InStr(b1 + 1, xr, "]", vbTextCompare)
s1 = Mid(xr, aa1 + 1, b1 - aa1 - 1)
s2 = Mid(xr, aa2 + 1, b2 - aa2 - 1)
aa3 = Mid(xr, 8, InStr(8 + 2, xr, ",", vbTextComparevbTextCompare) - 9)
aa = Mid(xr, b1 + 12, aa2 - b1)
aa4 = Mid(aa, 1, InStr(1, aa, ",", vbTextComparevbTextCompare) - 2)
arr1 = Split(s1, "}")
l1 = UBound(arr1) - LBound(arr1) + 1
Cells(kk + 1, 7) = aa3
Cells(kk + 2, 7) = aa4
'
For i = 0 To l1 - 2
If Cells(kk + 1, 8) <> "" Then
Cells(kk + 1, 8) = Cells(kk + 1, 8) & "," & Mid(arr1(i), 11, InStr(10, arr1(i), ",", vbTextCompare) - 12)
Else
Cells(kk + 1, 8) = Mid(arr1(i), 10, InStr(9, arr1(i), ",", vbTextCompare) - 11)
End If
Next i
arr1 = Split(s2, "}")
l1 = UBound(arr1) - LBound(arr1) + 1
For i = 0 To l1 - 2
If Cells(kk + 1 + 1, 8) <> "" Then
Cells(kk + 1 + 1, 8) = Cells(kk + 1 + 1, 8) & "," & Mid(arr1(i), 11, InStr(10, arr1(i), ",", vbTextCompare) - 12)
Else
Cells(kk + 1 + 1, 8) = Mid(arr1(i), 10, InStr(9, arr1(i), ",", vbTextCompare) - 11)
End If
Next i
'var end
Set oElement = oHtml.getElementsByClassName("jsx-1889249662")
Sheets("Item Details").Cells(kk + 1, 9) = oElement(2).innerText
'Debug.Print oElement(2).innerText
Set oElement = oHtml.getElementsByClassName("jsx-447347517 crumb")
For bb = 1 To oElement.Length
If Sheets("Item Details").Cells(kk + 1, 1) <> "" Then
Sheets("Item Details").Cells(kk + 1, 1) = Sheets("Item Details").Cells(kk + 1, 1) & "," & oElement(bb - 1).innerText
Else
Sheets("Item Details").Cells(kk + 1, 1) = oElement(bb - 1).innerText
End If
Next bb
Rows(kk + 1 & ":" & kk + 1).RowHeight = 20
'New specs
Set oElement = oHtml.getElementById("__NEXT_DATA__")
xx = oElement.innerHTML 'Mid(oElement.innerText, 41400, 3500) 'Right(oElement.innerText, 3000)
xf = InStr(1, xx, "specifications"":[")
xf1 = Len(xx) - (xf + 17)
xf2 = InStr(1, xx, "image_keys")
'Debug.Print xf
xr = Right(xx, xf1)
xf2 = InStr(1, xr, "image_keys")
xl = Left(xr, xf2 - 4)
Dim arr() As String
Dim a1() As String
arr = Split(xl, "{")
'Debug.Print arr(2)
l = UBound(arr) - LBound(arr) + 1
For i = 0 To l - 1
'Cells(i + 1, 1) = arr(i)
a1 = Split(arr(i), ",")
Sheets("Item Details").Cells(kk + 1, 10) = Left(Right(a1(0), Len(a1(0)) - 8), Len(Right(a1(0), Len(a1(0)) - 8)) - 1)
Sheets("Item Details").Cells(kk + 1, 11) = Left(Right(a1(2), Len(a1(2)) - 9), Len(Right(a1(2), Len(a1(2)) - 9)) - 2)
kk = kk + 1
'a1 = Split(arr(i), """")
Next i
'End Specs
'
'
'
'Set oElement = oHtml.getElementsByClassName("jsx-238694847 pdpImage")
'Debug.Print oElement.href
'Sheets("Item Details").Cells(kk + 1, 5) = oElement(0).href
'
'
''Call pct(kk + 1, 5)
'Cells(kk + 1, 5).ClearContents
End If
kk = kk + 1
Next kkk
'Next k
Call Macro1
End Sub