• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to get Google CSE JSON API data with excel VBA

kumar2837

New Member
Hi Friends,

I been using Excel VBA to pull Google CSE ATOM results into excel before that google has changed it to JSON API results.
Here is VBA script which can extract ATOM results into excel.

Reference for early binding: Microsoft XML v6.0

Public Sub Custom_Search_All()

Dim URLsSheet As Worksheet, resultsSheet As Worksheet
Dim lastRow As Long, r As Long
Dim result As Variant
Dim lst As IXMLDOMNodeList
Dim rownum As Long
rownum = 4
Set URLsSheet = ThisWorkbook.Worksheets("Sheet2")
Set resultsSheet = ThisWorkbook.Worksheets("Sheet1")
resultsSheet.Cells.ClearContents
resultsSheet.Range("A3:D3").Value = Array("Title", "Link", "Summary", "Updated")

With URLsSheet
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For r = 2 To lastRow
Set lst = Google_CSE1(.Cells(r, "A").Value)
For i = 0 To lst.Length - 1
result = GetNodeValues(lst(i))
resultsSheet.Cells(rownum, "A").Resize(1, UBound(result)).Value = result
rownum = rownum + 1
Next
Next
ReplaceTags resultsSheet
resultsSheet.Range("A3").Select
End With
End Sub


Public Function GetNodeValues(node As IXMLDOMNode) As Variant
Dim results(1 To 4) As String
results(1) = node.SelectSingleNode("a:title").Text
results(2) = node.SelectSingleNode("a:link").Attributes.getNamedItem("href").Text
results(3) = Replace(node.SelectSingleNode("a:summary").Text, vbLf, " ") 'remove multiple line chars
results(4) = Cvt_ISO8601DT_Excel(node.SelectSingleNode("a:updated").Text)
GetNodeValues = results
End Function


Public Function Google_CSE1(queryURL As String) As IXMLDOMNodeList

Static XMLdoc As DOMDocument60
Dim lst As IXMLDOMNodeList

'https://developers.google.com/custom-search/json-api/v1/reference/cse/list
'
'The cse.list method returns metadata about the search performed, metadata about the custom search engine used for the search, and the search results.
'
'This method requires three query parameters:
'
' The search engine to use in your request (using the cx query parameter)
' The search terms for in this request (using the q query parameter).
' Your API key (using the key query parameter).

If XMLdoc Is Nothing Then Set XMLdoc = New DOMDocument60
With XMLdoc

'How To Specify Namespace when Querying the DOM with XPath - https://support.microsoft.com/en-us/help/294797

'Search response starts with the following XML:
'< ?xml version="1.0" encoding="UTF-8"? >
'< feed gd:kind="customsearch#search" xmlns="http://www.w3.org/2005/Atom" xmlns:cse="http://schemas.google.com/cseapi/2010"
'xmlns:gd="http://schemas.google.com/g/2005" xmlns:eek:pensearch="http://a9.com/-/spec/opensearch/1.1/" >

XMLdoc.async = False
XMLdoc.validateOnParse = False
XMLdoc.SetProperty "SelectionLanguage", "XPath"
XMLdoc.SetProperty "SelectionNamespaces", "xmlns:a='http://www.w3.org/2005/Atom'"
XMLdoc.Load queryURL
End With
Set lst = XMLdoc.SelectNodes("/a:feed/a:entry")
Set Google_CSE1 = lst

End Function




Private Function Cvt_ISO8601DT_Excel(dt As String) As Date


'Convert ISO8601 date time UTC (in the format yyyy-mm-ddthh-mm-ssz) to an Excel date-time
' 1234567890123456789
'https://en.wikipedia.org/wiki/ISO_8601#UTC

Cvt_ISO8601DT_Excel = DateSerial(Mid(dt, 1, 4), Mid(dt, 6, 2), Mid(dt, 9, 2)) + TimeSerial(Mid(dt, 12, 2), Mid(dt, 15, 2), Mid(dt, 18, 2))

End Function


Sub ReplaceTags(sht As Worksheet)
sht.Activate
sht.Columns("C:C").Select
Selection.Replace What:="", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="
", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="
", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" ...", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="...", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
I want this script to modify to extract data from Google CSE JSON API results into excel.Can anyone help me with this.
 

Attachments

Top