Excel VBA错误:无效的过程调用或参数

时间:2019-06-01 06:42:24

标签: excel excel-vba

我正在尝试从下面两个网站中抓取数据。

Website 01

Website 02

两个网站都具有从中提取数据的相同结构和场所模式。我可以从一个网站成功提取数据,但是在抓取第二个网站时显示错误。

错误:无效的过程调用或参数

  

错误调试突出显示了代码的第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

0 个答案:

没有答案