使用 Selenium 进行 Excel VBA 网页抓取

问题描述

我想知道是否有人可以帮助我使用以下代码。

我通常使用相同的架构没有问题，但这次我在查找元素时出错。我不知道问题是来自网页设计还是（可能）我在 FindElementsBy 中输入了错误的代码...

非常感谢。

Option Explicit
Private ch As Selenium.ChromeDriver

Sub ScrapeEntriesTokyo()

    Dim FindBy As New Selenium.By
    Dim ResultSections As Selenium.WebElements
    Dim ResultSection As Selenium.WebElement
    Dim Entries As Selenium.WebElement
    
    Set ch = New Selenium.ChromeDriver
    
    ch.Start
    ch.Get "https://www.worldathletics.org/competitions/olympic-games/the-xxxii-olympic-games-athletics-7132391/athletes"

    Call Processtable
    
End Sub

Sub Processtable()
Dim TabletoProcess As Selenium.WebElement

    Dim AllRows As Selenium.WebElements
    Dim SingleRow As Selenium.WebElement
    Dim AllRowCells As Selenium.WebElements
    Dim SingleCell As Selenium.WebElement
    Dim OutputSheet As Worksheet
    Dim RowNum As Long,ColNum As Long
    Dim TargetCell As Range
    
    Application.ScreenUpdating = False
    
    Set OutputSheet = ThisWorkbook.Worksheets.Add
    
    Set AllRows = TabletoProcess.FindElementsByTag("tr")
    
    For Each SingleRow In AllRows
        
        RowNum = RowNum + 1
        
        Set AllRowCells = SingleRow.FindElementsByTag("td")
        
        If AllRowCells.Count = 0 Then
            Set AllRowCells = SingleRow.FindElementsByTag("th")
        End If
        
        
        For Each SingleCell In AllRowCells
            
            ColNum = ColNum + 1
            
            Set TargetCell = OutputSheet.Cells(RowNum,ColNum)
            
            TargetCell.Value = SingleCell.Text
            
            
        Next SingleCell
        
        ColNum = 0
        
    Next SingleRow
    
    OutputSheet.Range("A1").CurrentRegion.EntireColumn.AutoFit
    OutputSheet.ListObjects.Add Source:=OutputSheet.Range("A1").CurrentRegion
    
    Application.ScreenUpdating = True
    
End Sub
```

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）