excel 在特定地点提取规范部分的描述

Option Explicit
Private MB As Selenium.ChromeDriver
Sub Test()
Dim i As Long
Dim lastrow As Long
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrow
Dim MyURL As String
MyURL = Sheet1.Cells(i, 1).Value
Set MB = New Selenium.ChromeDriver
MB.Start
MB.Get MyURL
MB.Wait 10000
Dim specs As Selenium.WebElements
Dim values As Selenium.WebElements
Dim j As Long
Set specs = MB.FindElementsByCss("[data-testid='product-techs'] dt")
Set values = MB.FindElementsByCss("[data-testid='product-techs'] dd")
For j = 1 To 1
On Error GoTo Last
Sheet1.Cells(i, "B").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
For j = 1 To 2
On Error GoTo Last
Sheet1.Cells(i, "C").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
For j = 1 To 3
On Error GoTo Last
Sheet1.Cells(i, "D").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
For j = 1 To 4
On Error GoTo Last
Sheet1.Cells(i, "E").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
For j = 1 To 5
On Error GoTo Last
Sheet1.Cells(i, "F").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
For j = 1 To 6
On Error GoTo Last
Sheet1.Cells(i, "G").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
For j = 1 To 7
On Error GoTo Last
Sheet1.Cells(i, "H").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
For j = 1 To 8
On Error GoTo Last
Sheet1.Cells(i, "I").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
For j = 1 To 9
On Error GoTo Last
Sheet1.Cells(i, "J").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
For j = 1 To 10
On Error GoTo Last
Sheet1.Cells(i, "K").Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
Next
If i = lastrow Then
MB.Quit
End If
Next i
Last: Exit Sub
End Sub

在这里，我试图提取一些网页链接的规范部分。对于前2个链接，它只有10个“标签和值”，所以，所有被提取，但在第三个链接的情况下，它有超过10个“标签和值”没有被提取。我需要纠正上述代码，在这样一种方式，无论“标签和值”web链接的数量可以包含多少，它都应该提取所有的“标签和值”。
第一个链接：https://www.grainger.com/product/SALISBURY-Blanket-Canister-Orange-3KUX9第二个链接：https://www.grainger.com/product/SALISBURY-Blanket-Clamp-Pin-Yellow-5ZV66第三个链接：https://www.grainger.com/product/SCHNEIDER-ELECTRIC-IEC-Supplementary-Protector-482N41
请告诉我们如何才能改变这一点来完成它。我尝试了下面的修改...对于j = 1到规格。计数错误后藤最后一个工作表1.Cells（i，“B”）.Value = Join$（Array（specs.Item（j）.Text，values.Item（j）.Text），“：“）Next但是，它只提取列表中的最后一个标签和值，而不是全部。请帮助我解决这个问题。

只需循环specs（或values）中的项目数，就可以使用Count-属性检查项目数。
您可以使用MB.Timeouts.ImplicitWait = 10为驱动程序设置Timeout来加快代码的运行速度。这将等待最多10秒，但如果数据已加载，代码将继续运行。
请看下面的例程：

Sub Test()

    Dim MB As New Selenium.ChromeDriver
    MB.Timeouts.ImplicitWait = 10
    MB.Start
    
    Dim ws As Worksheet, row As Long, lastRow As Long, col As Long
    Set ws = ThisWorkbook.Sheets(1)
    row = 2
    lastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).row
    
    For row = 2 To lastRow
        ' Read Web page
        Dim MyURL As String
        MyURL = ws.Cells(row, 1)
        MB.Get MyURL

        ' Get values
        Dim specs As Selenium.WebElements
        Dim values As Selenium.WebElements
        Set specs = MB.FindElementsByCss("[data-testid='product-techs'] dt")
        Set values = MB.FindElementsByCss("[data-testid='product-techs'] dd")
    
        ' Write all values to Excel
        For col = 1 To specs.Count
            ws.Cells(row, col + 1).Value = specs.Item(col).Text & ":" & values.Item(col).Text
        Next col
    Next row
    
    MB.Quit
End Sub

excel 在特定地点提取规范部分的描述

1条答案

相关问题

热门标签

最新问答