Пытаясь перебрать веб-сайт с веб-сайта в Excel, а затем преобразовать в документ Word - PullRequest
Новая
       36

Пытаясь перебрать веб-сайт с веб-сайта в Excel, а затем преобразовать в документ Word

0 голосов
/ 02 мая 2018

Итак, мне поручили соскрести некоторую информацию с веб-сайта. Информация довольно тяжелая, и мне нужно нажимать отдельные кнопки «читать дальше», чтобы получить полную информацию. После того, как я нажму «читать дальше», мне нужно вернуться на предыдущую страницу, нажать «читать дальше» на втором пункте. Затем промойте и повторяйте, пока у меня не будет всей необходимой информации. Как только у меня будет вся информация, она должна быть преобразована в текстовый документ.

  1. Перейдите к URL, я знаю, как это сделать
  2. Нажмите «кнопку» с надписью «читать дальше». Проблема в том, что существует более 70 кнопок с надписью «читать дальше», и я не знаю, как их различить
  3. Как только я получу всю информацию, собери несколько частей информации, как мне получить ее, чтобы преуспеть ??
  4. Как только информация собрана в Excel, как мне преобразовать ее в слово?

Пример кода: 

'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, я уверен, что есть более простые способы, но я должен делать это именно так. Любая помощь или советы с благодарностью.

URL-адрес https://www.legacy.com/obituaries/commercialappeal/browse

1 Ответ

0 голосов
/ 04 мая 2018

Так что это было сложнее, чем ожидалось, поскольку у меня были проблемы с получением полного набора результатов. В итоге я выбрал selenium basic , так как он лучше справлялся с начальной загрузкой страницы, и я не получал повторных предупреждений о файлах cookie и тому подобном. Честно говоря, это может быть потому, что я использовал Chrome Driver! Конечно, драйвер можно изменить, чтобы другой поддерживаемый тип браузера.

Код: 

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 , чей код Word я угнал. Вам нужно будет привести это в порядок.
...