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.
Can anyone help me with this.
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.
I want this script to modify to extract data from Google CSE JSON API 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" 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
Can anyone help me with this.