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

如果这是一个困难的问题，我很抱歉，但我被卡住了，真的需要帮助：）

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

以下是我对如何实现这一点的思考过程：

1.我有一排东西（比如鸡、鱼、牛）
2.该算法将转到谷歌
3.算法根据单元格值进行搜索（第一次迭代将是“鸡”）
4.算法点击“新闻”
5.算法单击“工具”，然后单击“上周”
6.该算法提取单元格下的前五篇文章（例如，如果chicken在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

---

谢谢大家!

下面的内容应该适合您

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

Sub-XMLHTTPTest（）
将ws设置为工作表
Dim LastColumn为长，j为长，noNewsItems为长
Dim查询作为字符串，niDateStr作为字符串
尺寸xhr为MSXML2.XMLHTTP60
Dim gXML为MSXML2.DOMDocument60
将新闻项设置为IXMLDOMNodeList
Dim-nI-As-ixmldome元素
Dim StartOfWeek作为日期，EndOfWeek作为日期，niDate作为日期
StartOfWeek=DateAdd（“ww”，-1，日期-（工作日（日期，星期一）-1））
EndOfWeek=DateAdd（“d”，6，StartOfWeek）
设置xhr=New MSXML2.XMLHTTP60
设置ws=ActiveSheet
与ws
LastColumn=.Rows（1）.End（xlToLeft）.Column
以
对于j=1到最后一列
查询=”https://news.google.com/rss/search?q=“&ws.Cells（1，j）.Value2”
使用xhr
.打开“获取”，查询，False
.发送
设置gXML=.responseXML
Set newsItems=gXML.SelectNodes（“.//项”）
Debug.Print“已删除项目的数量：”，newItems.Length
noNewsItems=0
对于新闻项目中的每个nI
niDateStr=nI.ChildNodes（3）.nodeTypedValue
niDateStr=Mid（niDateStr，InStr（niDateStr，“”）+1，InStrRev（niDateStr，“”）-5）
niDate=DateValue（niDateStr）
如果niDate>=StartOfWeek和niDate Google有一个JSON api，您可以使用或使用他们的rss提要，例如，一个用于更新问题的明确+我需要在引用中启用一些内容吗？Dim xhr的错误是MSXML2.XMLHTTP60：未定义用户定义类型有没有办法让它只查看上周的结果？通过点击“工具”，然后选择“过去的一周”？我已经将其更新为只使用前一周日期的结果。您可能需要根据需要更改这些设置
StartOfWeek
和
EndOfWeek