excel - 如何使用 VBA 获取前五篇新闻文章的名称和链接

Question

如果这是一个艰难的问题，我很抱歉，但我被卡住了，真的可以使用帮助:)

我希望能够获得前五篇文章(文章名称将超链接到文章)并将它们放在各自的单元格下。

这是我关于如何实现这一点的思考过程:
1. 我连续有一堆元素(例如鸡、鱼、牛)
2.算法交给谷歌
3.算法根据单元格值进行搜索(第一次迭代将是“鸡”)
4.算法点击“新闻”
5.算法点击“工具”，然后点击“上周”
6.算法提取单元格下的前五篇文章(例如，如果鸡在A1中，那么这五篇文章将在A2-A6中)。该单元格将文章名称作为值，并带有指向实际文章的超链接。

我不希望 VBA 真正打开浏览器(我已经看到其他实现 XMLHTTP 来执行此操作的答案？)

试图:

Sub XMLHTTP()

    Dim url As String, lColumn As Integer, i As Long, v As Long
    Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object



For i = 1 To lastRow

'this is to get last column
lColumn = ws.Cells(i, Columns.Count).End(xlToLeft).Column

'searches google based on row'
url = "https://www.google.com/search?q=" & Cells(1, i)

'I don't know much about using XMLHTTP for vba online interaction but I found this online
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
        XMLHTTP.Open "GET", url, False
        XMLHTTP.setRequestHeader "Content-Type", "text/xml"
        XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
        XMLHTTP.send

Set objCollection = IE.Document.getElementsByTagName("input")
v = 0
If objCollection(v).Name = "Tools" Then objectelement.Click
If objCollection(v).Name = "Last Week" Then objectelement.Click
Next i
End Sub

谢谢!

Answer 1

像下面这样的东西应该适合你

Sub XMLHTTPTest()
    Dim ws As Worksheet
    Dim LastColumn As Long, j As Long, noNewsItems As Long
    Dim query As String, niDateStr As String
    Dim xhr As MSXML2.XMLHTTP60
    Dim gXML As MSXML2.DOMDocument60
    Dim newsItems As IXMLDOMNodeList
    Dim nI As IXMLDOMElement
    Dim StartOfWeek As Date, EndOfWeek As Date, niDate As Date

    StartOfWeek = DateAdd("ww", -1, Date - (Weekday(Date, vbMonday) - 1))
    EndOfWeek = DateAdd("d", 6, StartOfWeek)

    Set xhr = New MSXML2.XMLHTTP60

    Set ws = ActiveSheet
    With ws
        LastColumn = .Rows(1).End(xlToLeft).Column
    End With

    For j = 1 To LastColumn
        query = "https://news.google.com/rss/search?q=" & ws.Cells(1, j).Value2

        With xhr
            .Open "GET", query, False
            .send
            Set gXML = .responseXML
            Set newsItems = gXML.SelectNodes(".//item")
            Debug.Print "Number of scraped items:", newsItems.Length
            noNewsItems = 0
            For Each nI In newsItems
                niDateStr = nI.ChildNodes(3).nodeTypedValue
                niDateStr = Mid(niDateStr, InStr(niDateStr, " ") + 1, InStrRev(niDateStr, " ") - 5)
                niDate = DateValue(niDateStr)
                If niDate >= StartOfWeek And niDate <= EndOfWeek Then
                    noNewsItems = noNewsItems + 1
                    Debug.Print nI.ChildNodes(0).nodeTypedValue, nI.ChildNodes(1).nodeTypedValue, nI.ChildNodes(3).nodeTypedValue

                    ws.Hyperlinks.Add anchor:=ws.Cells(1, j).Offset(noNewsItems, 0), Address:=nI.ChildNodes(1).nodeTypedValue, TextToDisplay:=nI.ChildNodes(0).nodeTypedValue
                End If
                If noNewsItems = 5 Then Exit For
            Next nI
        End With
    Next j
End Sub