试图从网站抓取网页到 excel，然后转换成 word doc

Question

所以我被指派从网站上抓取一些信息。信息量很大，我需要单击各个“阅读更多”按钮才能获得完整信息。单击“阅读更多”后，我需要返回上一页，单击第二项上的“阅读更多”。然后冲洗并重复，直到我获得所需的所有信息。一旦我掌握了所有信息，就需要将其转换为 Word 文档。

1. 导航到 URL，我知道该怎么做
2. 点击“阅读更多”的“按钮”，问题是有超过 70 个按钮显示“阅读更多”，我不知道如何区分它们
3. 一旦我掌握了所有信息，就抓取了几条信息，我如何让它变得优秀？？
4. 信息收集到excel后，如何转换成word？

代码示例：

'Bring IE up and navigate to page
      Set ie = New SHDocVw.InternetExplorerMedium
      ie.Visible = True
      'Set the URL
      strURL = "my url"
      'Navigate to url
      ie.Navigate strURL
      'Wait for the page to show up

button.click?

我对 Vba 的 excel 选项相当陌生，我确信有更简单的方法，但这是我应该这样做的方式。非常感谢任何帮助或提示。

网址是https://www.legacy.com/obituaries/commercialappeal/browse

Answer 1

所以这比预期的要棘手，因为我在获取整个结果集时遇到了问题。最后我选择了selenium basic，因为它更好地处理了初始页面加载，并且我没有收到关于 cookie 等的重复警告。老实说，这可能是因为我使用了 Chrome 驱动程序！驱动程序当然可以更改为其他支持的浏览器类型。

代码：

Option Explicit

'281 Results on 2018-05-04 '16:00
Public Sub test()

    Dim d As WebDriver
    Set d = New ChromeDriver

    With d
        .Start "Chrome"
        .Get "https://www.legacy.com/obituaries/commercialappeal/browse?view=name"

        Dim elements  As List
        Set elements = d.FindElementsByTag("a").Attribute("href")

        Dim hrefCollection As New Collection, i As Long

        For i = 1 To elements.Count
            If InStr(elements(i), "https://www.legacy.com/obituaries/commercialappeal/obituary.aspx?n=") > 0 Then
                If i = 1 Then
                    hrefCollection.Add elements(i)
                ElseIf i > 1 And elements(i) <> elements(i - 1) Then
                    hrefCollection.Add elements(i)
                End If
            End If
        Next i
    End With

    Dim wrdApp As Object, wrdDoc As Object
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True

    Set wrdDoc = wrdApp.Documents.Add

    With wrdApp.ActiveDocument.PageSetup
        .Orientation = 1                         'wdOrientLandscape
        .TopMargin = wrdApp.InchesToPoints(0.98)
        .BottomMargin = wrdApp.InchesToPoints(0.98)
        .LeftMargin = wrdApp.InchesToPoints(0.98)
        .RightMargin = wrdApp.InchesToPoints(0.98)
    End With

    With wrdDoc
        .Styles.Add ("SHeading")
        .Styles.Add ("StdText")

        With .Styles("SHeading").Font
            .Name = "Arial"
            .Size = 14
            .Bold = False
            .Underline = True
        End With
        With .Styles("StdText").Font
            .Name = "Arial"
            .Size = 8
            .Bold = False
            .Underline = False
        End With
    End With

    wrdApp.Selection.Collapse Direction:=0       'wdCollapseEnd

    For i = 1 To 2                               '<== Test example to get two results
        DoEvents
        wrdApp.Selection.TypeParagraph
        wrdApp.Selection.Style = wrdDoc.Styles("SHeading")
        wrdApp.Selection.TypeText Text:=GetInfo(hrefCollection.Item(i), d)
    Next i

    '   For Each Item In hrefCollection  ''<== use this above to get all results
    '       DoEvents
    '       wrdApp.Selection.TypeParagraph
    '       wrdApp.Selection.Style = wrdDoc.Styles("SHeading")
    '       wrdApp.Selection.TypeText Text:=GetInfo(hrefCollection.Item(i), d)
    '   Next Item

    d.Quit
End Sub

Public Function GetInfo(ByVal url As String, ByVal d As WebDriver) As String
    With d
        .Get url
        GetInfo = d.FindElementByClass("ObitTextContent").Text
    End With
End Function

注意：

1. 我不会显示输出，因为不确定讣告是否需要出现在此站点上。
2. 感谢@Kyo谁是我劫持的字代码。你需要把它整理成你需要的东西。