Excel Makro zum Zeichnen von Thread-Kommentare von der Website in Zellen

Question

Ich versuche, Reddit Thread-Kommentare in einer Excel-Tabelle zu speichern, jedoch habe ich Probleme, herauszufinden, wie dies zu tun. Ich habe nicht viel Erfahrung damit, Makros zu verwenden, um Daten von Webseiten zu erhalten, also habe ich es schwer gefunden, herauszufinden, wie man jeden Kommentar von einem bestimmten Reddit-Thread genau herauszieht und in eine Zelle platziert, und ob das der Fall ist oder nicht möglich zu tun. Diese

ist das, was ich bisher:

Sub getRedditData() 

Dim x As Long, y As Long 
Dim htm As Object 

Set htm = CreateObject("htmlFile") 

With CreateObject("msxml2.xmlhttp") 
    .Open "GET", "https://www.reddit.com/r/AskReddit/comments/4p7qsx/what_are_the_most_common_modern_day_scams/", False 
    .send 
    htm.body.innerhtml = .responsetext 
End With 

With htm.getelementbyid("comments") 
    Set cellrangex = .Rows(x).Cells.Length - 1 
    Set cellrangey = .Rows(x).Cells.Length - 1 
    Set cellrange1 = Sheets(1).Cells(x + 1, y + 1).Value 
    Set cellrange2 = .Rows(x).Cells(y).innertext 

    For x = 0 To cellrangex 
     For y = 0 To cellrangey 
      cellrange = cellrange2 
     Next y 
    Next x 
End With 


End Sub 

Answer 1

Sie werden wirklich den Inhalt der Webseite analysieren müssen Sie mit einem anständigen HTML-Editor Schaben. Ich würde vorschlagen, zu der betreffenden Seite in Chrome zu navigieren und F12 zu verwenden, um das Entwicklerwerkzeug zu öffnen. In der Registerkarte "Elemente" können Sie schnell sehen, welcher HTML-Code welchen Teil der Seite erzeugt (öffnen Sie sowohl die Seite als auch die Entwickler-Tools nebeneinander).

Sie werden bemerken, wie Sie in die Kommentare gehen, dass der Text jedes Kommentars innerhalb eines <p> Tags ist und jedes <p> Tag in einem <div> ist. Wir suchen nach Mustern, also ist das ein guter Anfang.

Sie werden auch feststellen, dass jede dieser <div> Tags eine class von md hat. So ... Lässt alle Seiten <div>-Tags in ein Objekt laden und für die, die schauen dann, dass ein className haben, die "md" enthält:

Sub getRedditData()

Dim x As Long, y As Long 
Dim htm As Object 

Set htm = CreateObject("htmlFile") 

With CreateObject("msxml2.xmlhttp") 
    .Open "GET", "https://www.reddit.com/r/AskReddit/comments/4p7qsx/what_are_the_most_common_modern_day_scams/", False 
    .send 
    htm.body.innerhtml = .responsetext 
End With 

Set Divelements = htm.getElementsByTagName("div") 

For Each DivElement In Divelements 
    If InStr(1, DivElement.ClassName, "md") Then 
     'print contents to the Immediate window for debugging View>>Immediate Window to insure it's up in your VBE 
     Debug.Print DivElement.InnerText 
    End If 
Next 

End Sub

Damit sehen Sie alle Kommentare, die im Direkt-Fenster hängen bleiben (gehen Sie zu Ansicht >> Direktes Fenster), damit Sie diese Debug-Ausgabe sehen können.

---

Nachdem um den Knoten Überspringen sieht es aus wie Sie unten den Baum ein paar Elemente navigieren können und zurück, um den Benutzernamen zu erhalten:

Sub getRedditData() 

    Dim x As Long, y As Long 
    Dim htm As Object 

    Set htm = CreateObject("htmlFile") 

    With CreateObject("msxml2.xmlhttp") 
     .Open "GET", "https://www.reddit.com/r/AskReddit/comments/4p7qsx/what_are_the_most_common_modern_day_scams/", False 
     .send 
     htm.body.innerhtml = .responsetext 
    End With 

    Set Divelements = htm.getElementsByTagName("div") 


    On Error Resume Next 

    For Each divElement In Divelements 
     If InStr(1, divElement.className, "md") And Not InStr(1, divElement.className, "md-container") Then 
      Set commentEntry = divElement.ParentNode.ParentNode.ParentNode 

      'Print the name and the comment 
      Debug.Print commentEntry.FirstChild.FirstChild.NextSibling.InnerText & ":", divElement.InnerText 

     End If 
    Next 

End Sub 

Um dies nur zeigen auf dem Blatt auszudrucken eine Zelle anstelle des debug.print unmittelbaren Fensters. Etwas wie:

Sub getRedditData() 

    Dim x As Long, y As Long 
    Dim htm As Object 
    Dim ws As Worksheet, wsCell As Integer 

    'set the worksheet to print to and the first row to start printing. 
    Set ws = Sheets("Sheet1") 
    wsCell = 1 

    Set htm = CreateObject("htmlFile") 

    With CreateObject("msxml2.xmlhttp") 
     .Open "GET", "https://www.reddit.com/r/AskReddit/comments/4p7qsx/what_are_the_most_common_modern_day_scams/", False 
     .send 
     htm.body.innerhtml = .responsetext 
    End With 

    Set Divelements = htm.getElementsByTagName("div") 


    On Error Resume Next 

    For Each divElement In Divelements 
     If InStr(1, divElement.className, "md") And Not InStr(1, divElement.className, "md-container") Then 
      Set commentEntry = divElement.ParentNode.ParentNode.ParentNode 

      'Print the name and the comment to ws sheet columns 1 and 2 
      ws.Cells(wsCell, 1).Value = commentEntry.FirstChild.FirstChild.NextSibling.InnerText 
      ws.Cells(wsCell, 2).Value = divElement.InnerText 

      'iterate to the next row 
      wsCell = wsCell + 1 

     End If 
    Next 
End Sub