Question

对不起，这很困难，但是我被卡住了，真的可以使用帮助了：）

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

这是我关于如何实现此过程的思考过程：

1.我连续有一堆物品（例如鸡肉，鱼，牛）
2.该算法转到Google
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

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

1 个答案: