Excelマクロを使用してウェブサイトのスレッドコメントをセルに描画する

Question

RedditのスレッドコメントをExcelスプレッドシートに保存しようとしていますが、これを行う方法を理解するのに問題がありました。マクロを使ってウェブページからデータを取得する経験はあまりないので、指定されたRedditスレッドから各コメントをどのように引き出してセルに配置するのかを正確に把握することが難しくなっていますできます。

これは私がこれまで持っているものです。

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

あなたは本当にあなたがまともなHTMLエディタでこするされているウェブページの内容を分析する必要があります。問題のページをクロームでナビゲートし、F12を使用して開発者用ツールを開くことをお勧めします。 「要素」タブでは、どのHTMLがページのどの部分を作成しているかを素早く確認できます（ページと開発者のツールを相互に開きます）。

各コメントのテキストが<p>タグ内にあり、各<p>タグが<div>の内側にあるというコメントに目を向けると気付くでしょう。我々はパターンを探しているので、これは良いスタートです。

また、<div>タグのそれぞれには、classがmdとなっています。 だから... ...オブジェクトにページ<div>タグのすべてをロードし"md"が含まれているclassNameを持っているものを探しましょう：

サブ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の

これで、イミディエイトウィンドウに表示されているすべてのコメントが表示されます（[表示]> [イミディエイトウィンドウ]に移動）ので、このデバッグ出力を確認できます。ちょうどにポイントシートにこれをプリントアウトするには

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 

：あなたは要素のカップルをナビゲートすることができ、バックツリーの下のユーザ名を取得するように見えるノードの周りに飛ばした後

---

直接ウィンドウの代わりにセルを使用します。次のようなものがあります。

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