How to fix excel VBA to extract google cse JSON API results.

[satish78]

Hi Friends,

I have constructed list of Google CSE JSON API urls with keywords to extract Linkedin profiles data into excel.
I have VBA script which can extract Google CSE ATOM results. But, unfortunately Google has change ATOM results to JSON API results.
So, the script is not useful anymore.


I need title, url and snippet into ColumnA, ColumnB and ColumnC in sheet2.
Here is sample Macro enabled file with urls in sheet1 and sheet3 additional urls to test run on them.

https://spaces.hightail.com/space/83i4MjL8p4

 

[satish78]

No, I haven't found any documentation showing whether 'your' query syntax is accepted by the Custom Search API. I suggest you try your queries using the API explorer at https://developers.google.com/custom-search/v1/cse/list. AFAIK the q parameter only accepts a simple search term, without any of the fancy parameters you are trying.

yes, It will accept.

Here is the previous example for VBA script which extracted ATOM results

'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" xmlnspensearch="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

 

[Macropod]

Cross-posted at: https://chandoo.org/forum/threads/how-to-get-google-cse-json-api-data-with-excel-vba.41618/
Please read Mr Excel's policy on Cross-Posting in rule 13: http://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html