Vba - Number Of Google News Search Results

I have a cell that contains something I would like searched in google news. I want the code to return the number of results for that search. Currently I have this code which I foun

Solution 1:

Best option (IMO) is to use the Google News API and register for an API key. You can then use a queryString including your search term and parse the JSON response to get the result count. I do that below and also populate a collection with the article titles and links. I use a JSON parser called JSONConverter.bas which you download and add to your project. You can then go to VBE > Tools > References > add a reference to Microsoft Scripting Runtime.

---

Sample JSON response from API:

The {} denotes a dictionary which you access by key, the [] denotes a collection which you access by index or by For Each loop over.

I use the key totalResults to retrieve the total results count from the initial dictionary returned by the API.

I then loop the collection of dictionaries (articles) and pull the story titles and URLs.

You can then inspect the results in the locals window or print out

Sample of results in locals window:

---

OptionExplicitPublicSub GetStories()
    Dim articles As Collection, article AsObjectDim searchTerm AsString, finalResults As Collection, json AsObject, arr(0To1)
    Set finalResults = New Collection
    searchTerm = "Obama"With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://newsapi.org/v2/everything?q=" & searchTerm & "&apiKey=yourAPIkey", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        Set json = JsonConverter.ParseJson(.responseText)
    EndWith

    Debug.Print "total results = " & json("totalResults")

    Set articles = json("articles")
    ForEach article In articles
       arr(0) = article("title")
       arr(1) = article("url")
       finalResults.Add arr
    NextStop'<== Delete me laterEndSub

---

Loop:

If deploying in a loop you can use a class clsHTTP to hold the XMLHTTP object. This is more efficient than creating and destroying. I supply this class with a method GetString to retrieve the JSON response from the API, and a GetInfo method to parse the JSON and retrieve the results count and the API results URLs and Titles.

Example of results structure in locals window:

Class clsHTTP:

Option Explicit   
Private http AsObjectPrivate Sub Class_Initialize()
    Set http = CreateObject("MSXML2.XMLHTTP")
End Sub

PublicFunctionGetString(ByVal url AsString) AsStringWithhttp
        .Open "GET", url, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .sendGetString = .responseTextEndWithEndFunctionPublicFunctionGetInfo(ByVal json AsObject) AsVariantDimresults(), counterAsLong, finalResults(0 To 1), articlesAsObject, articleAsObjectfinalResults(0) = json("totalResults")
    Setarticles = json("articles")

    ReDimresults(1 To articles.Count, 1 To 2)

    ForEacharticleInarticlescounter = counter + 1
        results(counter, 1) = article("title")
        results(counter, 2) = article("url")
    NextfinalResults(1) = resultsGetInfo = finalResultsEndFunction

Standard module:

OptionExplicitPublicSub GetStories()
    Dim http As clsHTTP, json AsObjectDim finalResults(), searchTerms(), searchTerm AsLong, url AsStringSet http = New clsHTTP

    With ThisWorkbook.Worksheets("Sheet1")
        searchTerms = Application.Transpose(.Range("A1:A2")) '<== Change to appropriate range containing search termsEndWithReDim finalResults(1To UBound(searchTerms))

    For searchTerm = LBound(searchTerms, 1) To UBound(searchTerms, 1)

        url = "https://newsapi.org/v2/everything?q=" & searchTerms(searchTerm) & "&apiKey=yourAPIkey"Set json = JsonConverter.ParseJson(http.GetString(url))

        finalResults(searchTerm) = http.GetInfo(json)

        Set json = NothingNextStop'<==Delete me laterEndSub'

---

Otherwise:

I would use the following where I grab story links by their class name. I get the count and write the links to a collection

OptionExplicitPublicSub GetStories()
    Dim sResponse AsString, html As HTMLDocument, articles As Collection
    Const BASE_URL AsString = "https://news.google.com/"With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://news.google.com/topics/CAAqIggKIhxDQkFTRHdvSkwyMHZNRGxqTjNjd0VnSmxiaWdBUAE?hl=en-US&gl=US&ceid=US:en", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    EndWithSet html = New HTMLDocument: Set articles = New Collection
    Dim numberOfStories AsLong, nodeList AsObject, i AsLongWith html
        .body.innerHTML = sResponse
        Set nodeList = .querySelectorAll(".VDXfz")
        numberOfStories = nodeList.Length
        Debug.Print "number of stories = " & numberOfStories
        For i = 0To nodeList.Length - 1
            articles.Add Replace$(Replace$(nodeList.item(i).href, "./", BASE_URL), "about:", vbNullString)
        NextEndWith
    Debug.Print articles.Count
EndSub

---

Standard Google search:

The following works an example standard google search but you will not always get the same HTML structure depending on your search term. You will need to provide some failing cases to help me determine if there is a consistent selector method that can be applied.

OptionExplicitPublicSub GetResultsCount()
    Dim sResponse AsString, html As HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.google.com/search?q=mitsubishi", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    EndWithSet html = New HTMLDocument
    With html
        .body.innerHTML = sResponse
        Debug.Print .querySelector("#resultStats").innerText
    EndWithEndSub