Skip to content

Instantly share code, notes, and snippets.

@brucemcpherson

brucemcpherson/restlibraryexamples.vba

Last active December 16, 2015 10:19
Show Gist options
  • Save brucemcpherson/5419531 to your computer and use it in GitHub Desktop.
Save brucemcpherson/5419531 to your computer and use it in GitHub Desktop.
Download ZIP
rest library examples to test excel rest library - ramblings.mcpher.com
Raw
restlibraryexamples.vba
Option Explicit
'for more about this
' http://ramblings.mcpher.com/Home/excelquirks/classeslink/data-manipulation-classes
'to contact me
' http://groups.google.com/group/excel-ramblings
'reuse of code
' http://ramblings.mcpher.com/Home/excelquirks/codeuse
' google rules and api documentation
' http://code.google.com/apis/patentsearch/v1/jsondevguide.html
'All this tests out the restlibrary and cRest class
' v2.17
'---------------
' NOTE
' Many APIS come and go or change or need authorization over time
' when I notice, i usually delete the sheet for their data, but leave the code here
' that means that some of these wont work, although they did when first written
'----------
Private Function testfix()
Dim cr As cRest, sFix As String
sFix = readFromFile("banreservas.json")
If (sFix = vbNullString) Then
MsgBox ("nothing to do")
Else
Set cr = restQuery("dataout", , , , "http://nowhere.com", , , False, , , True, sFix)
makeHeadingsFromData cr
cr.teardown
Set cr = restQuery("dataout", , , , "http://nowhere.com", , , , , , True, sFix)
cr.teardown
End If
End Function
Private Function testfix2()
Dim cr As cRest, sFix As String
sFix = Range("taxdata!b1").value
If (sFix = vbNullString) Then
MsgBox ("nothing to do")
Else
Set cr = restQuery("dataout", , , , "http://nowhere.com", , , False, , , True, sFix)
makeHeadingsFromData cr
cr.teardown
Set cr = restQuery("dataout", , , , "http://nowhere.com", , , , , , True, sFix)
cr.teardown
End If
Dim ds As New cDataSet, c As cCell
With ds.load("dataout").columns("time")
For Each c In .rows
c.value = fromISODateTime(c.value)
Next c
.Commit
ds.teardown
End With
End Function
Private Function oddFormat()
Dim cr As cRest, job As cJobject, jo As cJobject, _
sFix As String, jor As cJobject, jof As cJobject, data As cJobject
' this file is in an odd format
With JSONParse(readFromFile("JsonExampleEventResults.json"))
' so first we'll reorganize it into a proper json object array of key value pairs
Set job = New cJobject
job.init Nothing
Set data = job.add("data").addArray
For Each jo In .child("database.table_data").children
For Each jor In jo.child("row").children
With data.add
For Each jof In jor.child("field").children
.add jof.toString("-name"), jof.children(2).value
Next jof
End With
Next jor
Next jo
End With
' now we can do a normal thing
sFix = job.stringify
Set cr = restQuery("dataout", , , , "http://nowhere.com", "data", , False, , , True, job.stringify)
makeHeadingsFromData cr
cr.teardown
Set cr = restQuery("dataout", , , , "http://nowhere.com", "data", , , , , True, sFix)
cr.teardown
End Function
Private Function taxdata()
Dim cr As cRest, sFix As String, job As cJobject, outSheet As String
'' change this to wherever the JSON is .. or update the 1st query to get it from its source
sFix = Range("taxdata!a1").value
outSheet = "taxout"
If (sFix = vbNullString) Then
MsgBox ("nothing to do")
Else
wholeSheet(outSheet).Delete
Set cr = restQuery(outSheet, , , , "http://nowhere.com", "Taxlines.1.TaxDetails", , False, , , True, sFix)
makeHeadingsFromData cr
cr.teardown
With restQuery(outSheet, , , , "http://nowhere.com", "Taxlines.1.TaxDetails", , , , , True, sFix)
' now need to add some space for the summary data
Dim ds As New cDataSet
ds.load (outSheet)
For Each job In .jObject.children
If (Not job.isArrayRoot) Then
With ds.headingRow.where.Resize(1, 1)
.EntireRow.insert
.Offset(-1, 0).value = job.key
.Offset(-1, 1).value = job.value
End With
End If
Next job
.teardown
ds.teardown
End With
End If
End Function
Private Function testOverrides()
Dim masterDs As cDataSet, dr As cDataRow, dc As cCell, updateDs As cDataSet
' get the old data
Set masterDs = New cDataSet
masterDs.populateData wholeSheet("mastersheet"), , , True, , , True, "id"
' get the new data
generalQuery("overrides", "getOverrides", "", False, True).teardown
Set updateDs = New cDataSet
With updateDs.load("overrides")
' update
For Each dr In .rows
For Each dc In dr.columns
masterDs.cell(dr.toString("id"), .headings(dc.column).toString).value = dc.value
Next dc
Next dr
'clean up
.teardown
End With
'commit changes
With masterDs
.bigCommit
.teardown
End With
End Function
Private Function testinvalids()
testInvalid "1000005806835"
testInvalid "9501100300232"
End Function
Private Function testInvalid(v As String)
With restQuery("dataout", , v, , _
"http://myapp-cp.com/syrisoft_apps/yarmook_association/api/index.php?type=barcode&value=", , , , , False)
If .datajObject Is Nothing Then
Debug.Print "no data"
Else
Debug.Print .jObject.stringify
End If
.teardown
End With
End Function
Public Sub testColorSchemerClosest()
Dim scheme As String, joc As cJobject
Dim job As cJobject, jt As cJobject, n As Long
scheme = InputBox("Which scheme (htm,pms,pfh or dulux)?")
n = 0
With restQuery("colorschemer", "colorschemer", , _
"target", , , , False, , , , , , , , , _
"&provider=parse&closest=5&scheme=" & scheme)
For Each job In .jObjects
n = n + 1
For Each joc In job.child("c").children
With .dset.headingRow.where.Offset(n, joc.childIndex).Resize(1, 1)
.Interior.Color = joc.child("properties.rgb").value
Set jt = joc.child("colortable.label")
' would only exist if this was from a scheme
If (jt Is Nothing) Then
.value = joc.child("colortable.hex").value
Else
.value = jt.value
End If
.Font.Color = joc.child("properties.textColor").value
End With
Next joc
Next job
' modify heading
.dset.headingRow.headings(2).where.value = "Matching this against scheme " & scheme
.teardown
End With
End Sub
Private Function oauthAnalyticsAccounts()
' if you are using oauth2, the scope and authtype need to be set up in the library
' .add "authType", erOAUTH2
' .add "authScope", "analytics"
' you also need to have set up credentials in registry as desceibed in
' http://ramblings.mcpher.com/Home/excelquirks/googleoauth2
With generalQuery("ua accounts", "ua accounts", vbNullString, , True)
.teardown
End With
End Function
Private Function oauthAnalyticsWebProperties()
' if you are using oauth2, the scope and authtype need to be set up in the library
' .add "authType", erOAUTH2
' .add "authScope", "analytics"
' you also need to have set up credentials in registry as desceibed in
' http://ramblings.mcpher.com/Home/excelquirks/googleoauth2
Dim id As String
' id of web account
id = "~all"
With generalQuery("ua web properties", "ua web properties", id)
.teardown
End With
End Function
Private Function oauthAnalyticsProfiles()
' if you are using oauth2, the scope and authtype need to be set up in the library
' .add "authType", erOAUTH2
' .add "authScope", "analytics"
' you also need to have set up credentials in registry as desceibed in
' http://ramblings.mcpher.com/Home/excelquirks/googleoauth2
Dim id As String, profiles As String
' id of web account
id = "~all"
profiles = "~all"
With generalQuery("ua profiles", "ua web properties", id, , , "/" & profiles & "/profiles")
.teardown
End With
End Function
Private Function oauthAnalyticsData()
' if you are using oauth2, the scope and authtype need to be set up in the library
' .add "authType", erOAUTH2
' .add "authScope", "analytics"
' you also need to have set up credentials in registry as desceibed in
' http://ramblings.mcpher.com/Home/excelquirks/googleoauth2
Dim metrics As String, profiles As String, startDate As String, endDate As String, r As Range, _
job As cJobject, joc As cJobject, jor As cJobject, dimensions As String
metrics = "ga:pageviews,ga:visits,ga:visitors"
dimensions = "ga:day"
startDate = "2013-11-01"
endDate = "2013-11-30"
profiles = "34421202"
With restQuery("ua data", "ua data", profiles, , , , , False, , , , , , , , , "&start-date=" & startDate & _
"&end-date=" & endDate & "&metrics=" & metrics & "&dimensions=" & dimensions)
' populating manually
' delete any existing data
With .dset
If Not .headingRow.where Is Nothing Then .headingRow.where.ClearContents
If Not .where Is Nothing Then .where.ClearContents
Set r = firstCell(.headingRow.where)
End With
' create some column headings
Set job = .jObject.childExists("columnHeaders")
Debug.Assert Not job Is Nothing
For Each joc In job.children
r.Offset(, joc.childIndex - 1).value = joc.child("name").value
Next joc
' now the data
Set job = .jObject.childExists("rows")
Debug.Assert Not job Is Nothing
For Each jor In job.children
For Each joc In jor.children
r.Offset(jor.childIndex, joc.childIndex - 1).value = joc.value
Next joc
Next jor
.teardown
End With
End Function
Private Sub testSr()
Dim sFix As String, cr As cRest, outer As String, job As cJobject, joa As cJobject, _
joe As cJobject, joc As cJobject, r As Range
' simulate some results
outer = "stepResults"
sFix = "{'data':[ " & _
"{'a':'first','stepResults':[{'sa':'a1' ,'sb' :'b1' }, { 'sa':'a2' ,'sb' :'b2' }]} " & _
",{'a':'second','stepResults':[{'sa':'c1' ,'sb' :'d1' }, { 'sa':'c2' ,'sb' :'d2' }]} " & _
"] }"
' do a fake query and dont populate- replace this with the real query
With restQuery("sr", , , , "dummyurl", "data", , False, , , True, sFix)
' so now we have the data, first step, clear any existing data
With .dset
If Not .where Is Nothing Then .where.ClearContents
Set r = firstCell(.headingRow.where)
End With
'next just go through each row
For Each job In .datajObject.children
Set joe = job.childExists(outer)
' must always have one I guess
Debug.Assert Not joe Is Nothing
' now make a row for each item in the outer join
For Each joc In joe.children
' assuming that every child of the inner array has been set up as a column heading.
' and that outer is an array
Debug.Assert joc.isArrayMember
Set r = r.Offset(1)
' duplicate the other children
For Each joa In job.children
If joa.key <> outer Then
If Not .dset.headingRow.exists(joa.key) Is Nothing Then
r.Offset(, .dset.column(joa.key).column - 1).value = joa.value
End If
End If
Next joa
For Each joa In joc.children
If Not .dset.headingRow.exists(joa.key) Is Nothing Then
r.Offset(, .dset.column(joa.key).column - 1).value = joa.value
End If
Next joa
Next joc
Next job
' and release any memory
.teardown
End With
End Sub
Private Sub testCourses()
Dim cr As cRest, id As String
id = "556007"
' we'll do the query
Set cr = restQuery("lescourses", "lescourses", id, , , , , False)
' now create the headers
makeHeadingsFromData cr
cr.teardown
' we can just do it again
With restQuery("lescourses", "lescourses", id)
.teardown
End With
End Sub
Public Sub makeHeadingsFromData(cr As cRest)
Dim jobHead As cJobject, job As cJobject, joc As cJobject, jod As cJobject
Set jobHead = New cJobject
With cr
' first step, identify the headings
' this will also take care of situation when each item doesnt have the same children
Set jobHead = jobHead.init(Nothing)
For Each job In .datajObject.children
Set jobHead = rescurseHeadersFromJob(job, jobHead)
Next job
' now we have all possible titles, we can create column headings
.dset.headingRow.where.ClearContents
With firstCell(.dset.headingRow.where)
For Each job In jobHead.children
.Offset(, job.childIndex - 1).value = Replace(job.key, "___", ".")
Next job
End With
.teardown
End With
jobHead.teardown
End Sub
Public Sub intercom()
Dim endPoint As String, cr As cRest, pageNumber As Long, _
jobAll As cJobject, totalPages As Long, job As cJobject, jo As cJobject, _
maxPages As Long
maxPages = 0
endPoint = "https://api.intercom.io/v1/users?page="
pageNumber = 1
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Do
With restQuery("targetsheet", , CStr(pageNumber), , endPoint, , , False, , , _
, , "username", "password", , , , False)
If (isSomething(.jObject.child("error"))) Then
MsgBox (.jObject.stringify)
Exit Sub
End If
totalPages = .jObject.child("total_pages").value
Debug.Print "page "; pageNumber; "/"; totalPages
If (jobAll Is Nothing) Then
Set jobAll = .jObject.child("users")
Else
For Each jo In .jObject.child("users").children
jobAll.append jo
Next jo
End If
End With
pageNumber = pageNumber + 1
Loop Until (pageNumber > totalPages Or (pageNumber > maxPages And maxPages <> 0))
Debug.Print "formatting "; jobAll.children.count; " rows"
totot jobAll
Debug.Print "clearing up"
jobAll.teardown
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Public Sub totot(job As cJobject)
Dim ds As cDataSet, target As Range, dc As cCell, jo As cJobject
' clear the target sheet
Set ds = New cDataSet
' need something there to load
Set target = Sheets("targetsheet").Range("a1")
If IsEmpty(target.value) Then
target.value = "dummy"
End If
ds.load target.Worksheet.name
' create headings based on all data found
makeHeadingsFromJob job, ds
ds.teardown
' now reload with new headings
Set ds = New cDataSet
ds.load (target.Worksheet.name)
' now populate the data
With ds.headingRow
For Each jo In job.children
For Each dc In .headings
If (isSomething(jo.child(dc.value))) Then
.where.Resize(1, 1).Offset(jo.childIndex, dc.column - 1).value = jo.child(dc.value).value
End If
Next dc
If (jo.childIndex Mod 1000 = 0) Then
Debug.Print "done "; jo.childIndex; " rows"
End If
Next jo
End With
' clean up
ds.teardown
End Sub
Public Sub makeHeadingsFromJob(jo As cJobject, ds As cDataSet)
Dim jobHead As cJobject, job As cJobject, joc As cJobject, jod As cJobject
Set jobHead = New cJobject
' first step, identify the headings
' this will also take care of situation when each item doesnt have the same children
Set jobHead = jobHead.init(Nothing)
For Each job In jo.children
Set jobHead = rescurseHeadersFromJob(job, jobHead)
Next job
' let's clear all existing
If (isSomething(ds.where)) Then
ds.where.ClearContents
End If
ds.headingRow.where.ClearContents
' now the heading
With firstCell(ds.headingRow.where)
For Each job In jobHead.children
.Offset(, job.childIndex - 1).value = Replace(job.key, "___", ".")
Next job
End With
jobHead.teardown
End Sub
Private Function rescurseHeadersFromJob(job As cJobject, _
jobHead As cJobject, Optional k As String = vbNullString) As cJobject
Dim joc As cJobject, s As String
' the trick here is to collapse to a single depth- we'll replace the underscores with . later
If job.hasChildren Then
If k <> vbNullString Then k = k + "___"
For Each joc In job.children
rescurseHeadersFromJob joc, jobHead, k + joc.key
Next joc
Else
If k = vbNullString Then k = job.key
If (Not IsEmpty(job.value)) Then
jobHead.add k
End If
End If
Set rescurseHeadersFromJob = jobHead
End Function
Sub toto()
Dim dset As New cDataSet, cb As New cBrowser, jo As New cJobject
dset.populateJSON jo.deSerialize( _
cb.httpGET( _
"http://192.168.0.5:3480/data_request?id=lr_dmData&start=1381078846&stop=1381073153&channel1=50" _
) _
).child("series"), Range("Feuil1!$a$1")
End Sub
Private Sub ptp2()
Dim s As String
s = "{'series':[{'label':'Fibaro Plug - Watts','Id':50,'data':[[1380987292000,5],[1380987301000,13],[1380987441000,13],[1380987565000,7],[1380987693000,8],[1380987817000,4],[1380987940000,7],[1380988064000,4],[1380988187000,12],[1380988310000,8],[1380988433000,6],[1380988558000,8],[1380988683000,12],[1380988806000,11],[1380988931000,7],[1380989054000,7],[1380989177000,7],[1380989301000,11],[1380989425000,6],[1380989549000,13],[1380989673000,7],[1380989797000,7],[1380989921000,9],[1380990045000,10],[1380990172000,10],[1380990298000,10],[1380990422000,13],[1380990545000,7],[1380990668000,4],[1380990803000,5],[1380990943000,12],[1380991068000,7]],'pointsRet':425,'pointsTot':7379,'min':0,'max':316}],'procTime':2.96,'min':1380987292,'max':1381073692}"
Dim sUrl As String, jor As cJobject, joc As cJobject, job As cJobject, r As Range
sUrl = "http://192.168.0.5:3480/data_request?id=lr_dmData&start=1381078846&stop=1381073153&channel1=50"
With restQuery("Feuil1", , , , sUrl, , , False, , , True, s)
Set r = firstCell(.dset.headingRow.where)
For Each job In .jObject.child("series").children
For Each jor In job.child("data").children
' assume heading becomes additional data fields
With r.Offset(jor.childIndex - 1)
.Offset(, 0).value = job.child("label").value
.Offset(, 1).value = job.child("id").value
For Each joc In jor.children
'data
.Offset(, joc.childIndex - 1 + 2).value = joc.value
Next joc
End With
Next jor
Next job
End With
End Sub
Private Sub ptp()
Dim sUrl As String, jor As cJobject, joc As cJobject, job As cJobject, r As Range
sUrl = "http://192.168.0.5:3480/data_request?id=lr_dmData&start=1381078846&stop=1381073153&channel1=50"
With restQuery("Feuil1", , , , sUrl, , , False, , , True)
Set r = firstCell(.dset.headingRow.where)
For Each job In .jObject.child("series").children
For Each jor In job.child("data").children
' assume heading becomes additional data fields
With r.Offset(jor.childIndex - 1)
.Offset(, 0).value = job.child("label").value
.Offset(, 1).value = job.child("id").value
For Each joc In jor.children
'data
.Offset(, joc.childIndex - 1 + 2).value = joc.value
Next joc
End With
Next jor
Next job
End With
End Sub
Sub showDataset()
Dim dr As cDataRow, dSets As cDataSets, dc As cCell
Set dSets = New cDataSets
With dSets
.create
.init Range("holy_grail"), , "MyTestData"
'wholeSheet("purchases"), , "testdata", , , True
With .dataSet("MyTestData")
MsgBox .name & " has " & .rows.count & _
" rows " & .columns.count & " columns" & _
" and the original data is at " & .where.Address
For Each dr In .rows
For Each dc In dr.columns
With dc
MsgBox ("The value of the cCell at " & _
" row " & .row & " col " & .column & _
" is " & .toString & _
" the original address is " & .where.Address)
End With
Next dc
Next dr
End With
End With
Set dSets = Nothing
End Sub
Public Sub testNestoria()
generalDataSetQuery("nestoria", "nestoria", "bbox", , , , False).teardown
End Sub
Public Sub testBooks()
With generalDataSetQuery("isbnq", "google books by isbn", "isbn")
.teardown
End With
End Sub
Public Sub testfreeGeoIP()
With generalDataSetQuery("freegeoip", "freegeoip", "host")
.dset.makeListObject
.teardown
End With
End Sub
Public Sub testGoogleCurrencyConverter()
generalDataSetQuery("googlecurrencyconverter", "googlecurrencyconverter", "currency").teardown
End Sub
Public Sub testrateExchangeCurrencyConverter()
generalDataSetQuery("rateexchangeconverter", "rate exchange", "currency").teardown
End Sub
Public Sub testneildegrassetysonquotes()
Dim i As Long
Const howMany = 10
For i = 1 To howMany
restQuery("neildegrassetysonquotes", "neildegrassetysonquotes", _
, , , , , , , , True, , , , (i <> 1)).teardown
Next i
End Sub
Public Sub testPoster()
Dim jo As cJobject
Set jo = New cJobject
With jo.init(Nothing)
.add "start_absolute", 1357023600000#
With .add("end_relative")
.add "value", 5
.add "unit", "days"
End With
With .add("metrics").addArray
With .add
With .add("tags")
With .add("host").addArray
.add , "foo"
.add , "foo2"
End With
With .add("type").addArray
.add , "bar"
End With
End With
End With
With .add
With .add("tags")
With .add("host").addArray
.add , "foo"
.add , "foo2"
End With
With .add("type").addArray
.add , "bar"
End With
End With
End With
End With
End With
' will fail - needs JSON response - use real restlibrary entry , and set populate to true
With restQuery(, "postTest", "?dump", , , , , False, , False, True, , , , , , , , jo.stringify)
' normal rest population - or do it manually
.teardown
End With
End Sub
Public Sub testxx()
Dim Cc As cCell, ds As New cDataSet
With restQuery("dataout", , , , "http://nowhere", "ratings", True, , , , True, Range("jsonin!a1").value)
With ds.load(.dset.headingRow.where.Worksheet.name).column("created")
.where.NumberFormat = "0"
For Each Cc In .rows
Cc.value = (CDbl(Cc.value) / 86400000) + 2556
Next Cc
.where.NumberFormat = "dd-mmm-yy hh:mm:ss"
.Commit
.teardown
End With
.teardown
End With
End Sub
Public Sub esriTest()
Dim cr As cRest
With restQuery("ESRI Response", "ESRI Query", , "geometry", , , , , False)
.teardown
End With
End Sub
Public Sub testBug()
Dim job As cJobject, ds As cDataSet, sheetName As String, joc As cJobject, hr As cCell
sheetName = "dataout2"
' set the rename field rules here
Set job = JSONParse("[{'from':'fields.customfield_10216','to':'something else'},{'from':'c','to':'d'}]")
Set ds = New cDataSet
' first rename them in reverse to enable rerunning
With ds.populateData(wholeSheet(sheetName), , , , , , True)
For Each joc In job.children
Set hr = .headingRow.exists(joc.toString("to"))
If Not hr Is Nothing Then
hr.where.value = joc.toString("from")
End If
Next joc
.teardown
End With
' do the query
With restQuery(sheetName, , , , "http://nowhere", "issues", _
True, , , , True, Range("jsonin!a2").value)
.teardown
End With
' rename again
Set ds = New cDataSet
With ds.populateData(wholeSheet(sheetName), , , , , , True)
For Each joc In job.children
Set hr = .headingRow.exists(joc.toString("from"))
If Not hr Is Nothing Then
hr.where.value = joc.toString("to")
End If
Next joc
.teardown
End With
End Sub
Public Sub testLukas()
Dim job As cJobject, r As Range, joc As cJobject
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' temporarily ive put the input data in a cell.. create your own lib entry
With restQuery("lukas", "lukas", , , , , , False, , , True, Range("jorgein!a2").value)
' this will not have populated, so i unwind it manually
' first clear anything there
Set r = firstCell(.dset.headingRow.where)
r.Worksheet.Cells.ClearContents
With .jObject
' now get the column title
For Each job In .child("fields").children
r.Offset(, job.childIndex - 1).value = job.value
Next job
' and the data
For Each job In .child("values").children
For Each joc In job.children
r.Offset(job.childIndex, joc.childIndex - 1).value = joc.value
Next joc
Next job
End With
.teardown
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Public Sub testJorge()
Dim q As String
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
q = "http://gisweb.miamidade.gov/ArcGIS/rest/services/ServStat/MapServer/0/query?text=&geometry=&geometryType=esriGeometryPoint&inSR=&spatialRel=esriSpatialRelIntersects&relationParam=&objectIds=&where=CREATEDDATE+%3E+date+%272013-06-1%27+and+zip+%3D+%2733145%27&time=&returnCountOnly=false&returnIdsOnly=false&returnGeometry=true&maxAllowableOffset=&outSR=&outFields=zip%2Cdetails%2CREFERENCENUMBER%2CREFERENCEID%2CTYPEKEY%2CTYPEDESCRIPTION%2CCSRTYPEDESCRIPTION%2CSTATUS%2CSTATUSPRIOR%2CSRCSTATUSDESCRIPTION%2CsrCSTATUSPRIORKEY%2CINTAKEDESCRIPTION%2CDEPARTMENTKEY%2CDEPARTMENTDESCRIPTION%2CGROUPKEY%2CGROUPDESCRIPTION%2CCREATEDDATE%2CUPDATEDDATE%2CDELETEDDATE%2CCLOSEDDATE%2CDUEDATE%2CDUEBUSINESSDATE%2CESTIMATEDDUEDATE%2CAVERAGEDURATIONDAYS%2CGOALDAYS%2CDURATIONDAYS%2CISOVERDUE%2CFOLIONUMBER%2CADDRESS%2CSTREETNUMBER%2CSTREETNAME%2CSTREETNAMEPREFIX%2CSTREETNAMESUFFIX%2CUNIT%2CCITY%2CXCOORDINATE%2CYCOORDINATE%2CaCTIVE%2CSTARTDATE%2CENDDATE&f=pjson"
With restQuery("Jorge", , , , q, _
"features", True, , , , True, , , , False)
.teardown
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Public Sub testJorge2()
With restQuery("Sheet1", , , , "http://nowhere", _
"records", True, , , , True, Range("Jorgein!a2").value, , , False)
.teardown
End With
End Sub
Public Sub testTagSiteJson()
generalQuery("tagsite", "tagsitejson", _
"0B92ExLh4POiZTFgwcWtXUG1qVU0").teardown
End Sub
Public Sub testTagSiteJsonDetail()
Dim cj As cJobject, n As Long, Cc As cCell, jo As cJobject, _
k As Long, jp As cJobject
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With restQuery("tagsitedetail", "tagsitejson", _
"0B92ExLh4POiZTFgwcWtXUG1qVU0", , , , , False)
' clear any existing data
If (Not .dset.where Is Nothing) Then .dset.where.ClearContents
For Each cj In .datajObject.children
' one for each page
For Each jo In cj.child("tags.tagmap").children
k = 0
For Each jp In jo.child("counts").children
k = k + jp.value
Next jp
' only if there is any data
If k > 0 Then
n = n + 1
' this will pick up the page info
For Each Cc In .dset.headingRow.headings
If Not cj.childExists(Cc.value) Is Nothing Then
Cc.where.Offset(n).value = cj.child(Cc.value).value
End If
Next Cc
' and here is the tag info
.dset.headingRow.exists("tag").where.Offset(n).value = _
jo.child("name").value
.dset.headingRow.exists("count").where.Offset(n).value = k
End If
Next jo
Next cj
.teardown
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Public Sub testDuckDuckGo()
generalQuery("duckduckgo", "duckduckgo", _
InputBox("Enter your duckduckgo query")).teardown
End Sub
Public Sub testSina()
generalQuery("sina", "sina", _
InputBox("Enter stock symbol")).teardown
End Sub
Public Sub testFqlStream()
Dim fqlQuery As String
fqlQuery = "SELECT message,share_count,likes " & _
"FROM stream WHERE CONTAINS('" & _
InputBox("message contains ?") & "')"
generalQuery("fqlStream", "fql", fqlQuery).teardown
End Sub
Public Sub testFqlFeed()
Dim fqlAccessToken As String
fqlAccessToken = "the access token"
generalQuery("fqlcompany", "fqlfeed", InputBox("feedname ?") & "/feed", , , _
"?access_token=" & fqlAccessToken).teardown
End Sub
Public Sub testFql()
Dim fqlQuery As String
fqlQuery = "SELECT name, location.street, location.city, location.state, fan_count, talking_about_count, " & _
"were_here_count FROM page WHERE CONTAINS('" & _
InputBox("name contains ?") & "') and location.city != ''"
generalQuery("fql", "fql", fqlQuery).teardown
End Sub
Public Sub testPublicStuff()
generalQuery("publicstuff", "publicstuff", "", , True).teardown
End Sub
Public Sub testgetrestlibrary()
Dim cr As cRest, ds As cDataSet, dc As cCell, cj As cJobject, ck As cJobject
' this uses indirection to find out where the rest library is and gets it
Set cr = restQuery(, "restserver", , , , , , False, , , True)
' now populate
If Not cr Is Nothing Then
Set ds = New cDataSet
ds.populateData wholeSheet("restlibrary"), , , , , , True
' if there is data, get rid of it
If Not ds.where Is Nothing Then
ds.where.ClearContents
ds.rePopulate
End If
' we have to do all this because rest library is not an array, otherwise we could have done automatically
With ds.headingRow.where.Resize(1, 1)
For Each cj In cr.jObject.children(1).children
For Each dc In ds.headings
If (makeKey(dc.value) = "name") Then
.Offset(cj.childIndex, dc.column - 1).value = cj.key
Else
If Not cj.childExists(dc.toString()) Is Nothing Then
.Offset(cj.childIndex, dc.column - 1).value = cj.child(dc.toString()).value
End If
End If
Next dc
Next cj
End With
End If
cr.teardown
ds.teardown
End Sub
Public Sub testScraperWiki()
generalQuery("scraperWiki", "scraperWiki", "500").teardown
End Sub
Public Sub testrxNormDrug()
generalQuery("rxNorm Drugs", "rxNorm Drugs", _
InputBox("Enter your rxNorm Drug name query")).teardown
End Sub
Public Sub testbuiltwith()
Dim myKey As String
' set you api Key here
myKey = ""
If myKey = vbNullString Then
MsgBox (" you need to get your own API key from builtwith.com to run this")
Else
generalQuery("builtwith", "builtwith", _
URLEncode(InputBox("Enter web site name")), , , myKey).teardown
End If
End Sub
Public Sub testTrades()
generalQuery("trades", "btc-e", "trades").teardown
End Sub
Public Sub testTicker()
generalQuery("ticker", "btc-e-ticker", "ticker").teardown
End Sub
Public Sub testDepth()
Dim cj As cJobject, cd As cJobject
With restQuery("depth", "btc-e", "depth", , , , , False)
If Not .dset.where Is Nothing Then
.dset.where.ClearContents
End If
For Each cj In .datajObject.child("asks").children
For Each cd In cj.children
firstCell( _
.dset.headingRow.where) _
.Offset(cj.childIndex, cd.childIndex - 1).value = cd.value
Next cd
Next cj
.teardown
End With
End Sub
Public Sub testUrlShorten()
generalDataSetQuery("url shorten", "url shorten", "longurl", , , "app").teardown
End Sub
Public Sub testUkPostcodes()
generalDataSetQuery("uk postcodes", "uk postcodes", "postcode").teardown
End Sub
Public Function getDataFromFusion(sheetName As String, _
Optional developerKey As String = vbNullString, _
Optional tableKey As String = vbNullString, _
Optional sql As String = vbNullString)
Dim where As Range, job As cJobject, jo As cJobject
If developerKey = "" Then developerKey = getFusionKey()
If tableKey = "" Then tableKey = "1pvt-tlc5z6Lek8K7vAIpXNUsOjX3qTbIsdXx9Fo"
If sql = "" Then sql = "select * from " & tableKey
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With restQuery(sheetName, "fusiondata", developerKey, , , , , False, , , , , , , , , sql)
' fusion tables carry their row and column names
' get rid of any data on sheet
If Not .dset.headingRow.where Is Nothing Then .dset.headingRow.where.Worksheet.Cells.ClearContents
' now column headings
Set where = Range(sheetName & "!a1")
For Each job In .jObject.child("columns").children
where.Offset(, -1 + job.childIndex).value = job.value
Next job
' now row values
For Each job In .jObject.child("rows").children
For Each jo In job.children
where.Offset(job.childIndex, -1 + jo.childIndex).value = jo.value
Next jo
Next job
.teardown
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Function
Public Sub testFusion()
''getDataFromFusion "Fusion", getFusionKey(), "1ly8xALmM6oKFllKmryUDWtvWjSffCr7hgd-GXkE"
getDataFromFusion "Fusion", getFusionKey(), "1pvt-tlc5z6Lek8K7vAIpXNUsOjX3qTbIsdXx9Fo"
End Sub
Public Sub testCrunchbaseRelationships()
generalQuery("crunchbase relationships", "crunchbase relationships", _
InputBox("Enter persons name (for example steve-jobs)")).teardown
End Sub
Public Sub testCrunchbaseCompanies()
generalQuery("who works at", "crunchbase companies", _
InputBox("Enter company name (for example google)")).teardown
End Sub
Public Sub testUrbaramaPseudoRest()
generalQuery("urbaramamashup", "urbaramamashup", _
InputBox("Enter any geocodable address around which to search"), , , _
"&within=" & InputBox("distance in km within which to look")).teardown
End Sub
''http://www.urbarama.com/api/project?sort=popular&offset=0&count=20&minx=-180&miny=-90&maxx=180&maxy=90&size=small&format=json
' this is going to be a mashup of geocoding, and architectural info close by
Public Sub testUrbaramaMashup()
' first get an address of some sort
Dim s As String, cr As cRest, lat As Double, lon As Double, d As Double
Dim minLat As Double, minLon As Double, maxLat As Double, maxLon As Double
s = InputBox("Provide an address to center on")
If (s <> vbNullString) Then
' geocode it
Set cr = restQuery(, "yahoo geocode", s, , , , , False, , False)
If Not cr Is Nothing Then
With cr.jObject
lat = CDbl(.find("latitude").value)
lon = CDbl(.find("longitude").value)
End With
d = InputBox("Within how many kilometers of " & s & "(" & lat & "," & lon & ")")
'find within a box of this dimensions around center and do urbarama rest query
If d > 0 Then
Set cr = generalQuery("urbarama", "urbarama", _
"&miny=" & CStr(getLatFromDistance(lat, d, -135)) & _
"&minx=" & CStr(getLonFromDistance(lat, lon, d, -135)) & _
"&maxy=" & CStr(getLatFromDistance(lat, d, 45)) & _
"&maxx=" & CStr(getLonFromDistance(lat, lon, d, 45)), False)
End If
End If
End If
cr.teardown
End Sub
Public Sub testFaa()
generalDataSetQuery("faa", "faa airport status", "airport code").teardown
End Sub
Public Sub testHansard()
generalQuery("whoWasInParliament", "who was In parliament", _
InputBox(prompt:="Enter date yyyy/mm/dd in this format for example 2012/05/16", _
title:="Hansard parliamentary attendance") & ".js").teardown
End Sub
Public Sub testIMDB()
Dim cr As cRest
Set cr = generalDataSetQuery("imdb", "imdb by title", "title")
cr.teardown
End Sub
Public Sub testPageRank()
generalDataSetQuery("page rank", "page rank", "domain").teardown
End Sub
Public Sub testYahooGeocode()
With generalDataSetQuery("geocoding", "yahoo geocode", "input address")
.teardown
End With
End Sub
Public Sub testYahooCountryGeocode()
generalDataSetQuery("countrygeo", "yahoo geocode", "input").teardown
End Sub
Public Sub testSentiments()
generalDataSetQuery("tweetsentiments", "tweetsentiments", "phrase").teardown
End Sub
Public Sub testHuffingtonPostElections()
generalQuery("huffingtonpost elections", "huffingtonpost elections", "", , True).teardown
End Sub
Public Sub testSentimentTopics()
generalDataSetQuery("sentimentTopics", "tweetsentiment topics", "topic").teardown
End Sub
Private Function testJorum(n As String, q As String) As cRest
Set testJorum = generalQuery("jorum " & n, "jorum", n & "/" & q & "/format.json")
End Function
Public Sub testJorumStats()
testJorum("monthly", _
InputBox(prompt:="Enter your start and finish year/month in this format for example 2012/05/2012/07", _
title:="Jorum Monthly Stats")).teardown
End Sub
Public Sub testJorumInstitutions()
testJorum("institutions", _
LCase(InputBox(prompt:="Enter all or and institution name example", _
title:="Jorum institutions Stats"))).teardown
End Sub
Public Sub testJorumLicenses()
testJorum("licences", LCase("all")).teardown
End Sub
Public Sub testCraea()
generalQuery("taxsheet", "craea", _
InputBox("Enter your country number")).teardown
End Sub
Public Sub testMercadolibre()
generalQuery("mercadolibre", "mercadolibre", _
InputBox("Enter your mercado libre query")).teardown
End Sub
Public Sub testEC2()
generalReport(restQuery("EC2", "EC2", , , , , , , , , True) _
, True).teardown
End Sub
Public Sub testBattleNet()
generalDataSetQuery("battlenet", "battlenet", "id").teardown
End Sub
Public Sub testEsimMarket()
Dim cj As cJobject, cTarget As cJobject, k As Variant, _
jor As cJobject, joq As cJobject, joc As cJobject, cr As cRest, _
Cc As cCell, r As Range, jo As cJobject, joa As cJobject, _
wn As String, job As cJobject, jon As cJobject, dr As cDataRow, iDone As Long
wn = "eSimResource"
Set cj = New cJobject
' this one is going to call many queries with different parameters
' first prepare what we want to collect
Set cTarget = cj.init(Nothing).add("esimmarket")
With cTarget.add("resources").addArray
For Each k In Array("iron", "grain", "oil", "stone", "wood", "diamond", _
"weapon", "house", "gift", "food", "ticket", "ds", "hospital")
.add , k
Next k
End With
With cTarget.add("countries").addArray
For k = 1 To 2
.add , k
Next k
End With
With cTarget.add("quality").addArray
For k = 1 To 1
.add , k
Next k
End With
' now we have the description of which queries to do, do multiple calls and store the results
iDone = 0
' start with a clearup
wholeSheet(wn).Offset(1).Cells.ClearContents
With cTarget.find("resources")
For Each jor In .children
With cTarget.find("countries")
For Each joc In .children
With cTarget.find("quality")
For Each joq In .children
Set cr = _
restQuery("esimresource", "esimresource", _
jor.toString & "/" & joc.toString & "/" & joq.toString, _
, , , , , False, False, , , , , True)
' we can add the parameters that generated this using a bit of a hack
If (Not cr Is Nothing) Then
With cr.dset
For Each dr In .rows
' ignore if done this one already
If (dr.row > iDone) Then
Set r = firstCell(dr.where)
Set Cc = .headingRow.exists("resources")
If (Not Cc Is Nothing) Then r.Offset(, Cc.column - 1).value = jor.value
Set Cc = .headingRow.exists("countries")
If (Not Cc Is Nothing) Then r.Offset(, Cc.column - 1).value = joc.value
Set Cc = .headingRow.exists("quality")
If (Not Cc Is Nothing) Then r.Offset(, Cc.column - 1).value = joq.value
iDone = dr.row
End If
Next dr
End With
End If
cr.teardown
Next joq
End With
Next joc
End With
Next jor
End With
cj.teardown
End Sub
Public Sub testTopsyHistogram()
Dim cr As cRest, jo As cJobject, r As Range, job As cJobject
Set cr = restQuery("topsy", "topsy histogram", , "topsy query", , , , False)
If Not cr Is Nothing Then
With cr
Set r = .dset.headingRow.where.Offset(1, 1).Resize(1, 1)
For Each job In .jObjects
With job.child("response.histogram")
For Each jo In .children
r.Offset(, jo.childIndex).value = jo.value
Next jo
End With
Set r = r.Offset(1)
Next job
End With
End If
cr.teardown
End Sub
Public Sub testTrello()
generalReport(restQuery( _
"trello", "trello", , , , , , , False, , True) _
, True).teardown
End Sub
Public Sub testBlister()
Dim q As String, jo As cJobject, ds As cDataSet, joc As cJobject, job As cJobject
Set jo = New cJobject
With restQuery("blister", "blister", InputBox("name of library"), _
, , , , False, , , , , , , , , _
jo.init(Nothing).add("package").add("name", InputBox("list name")).root.serialize)
Set ds = .dset
With .jObject
If .toString("status.code") = "good" Then
' create the headings
For Each job In .child("results.1.package.keys").children
With firstCell(ds.headingRow.where)
.Offset(0, job.childIndex - 1).value = job.value
End With
Next job
' now the data
For Each job In .child("results.1.package.items").children
For Each joc In job.children
With firstCell(ds.headingRow.where)
.Offset(joc.childIndex, job.childIndex - 1).value = joc.value
End With
Next joc
Next job
Else
MsgBox ("error getting data " & .serialize)
End If
End With
.teardown
End With
End Sub
Public Sub testBlisterFunction()
Dim q As String, joc As cJobject, job As cJobject
' change this to the appropriate query
q = "?func=blisterList&listName=blister.billboardhot100&maxMatch=10&sortId=sequence&listId=title"
' exceute the query, unravel the JSON, and populate the sheet
With restQuery("blisterFunctions", "blisterFunctions", , _
, , , , False, , False, True, , , , , , q)
For Each job In .jObject.children
For Each joc In job.children
.dset.headingRow.where.Resize(1, 1) _
.Offset(job.childIndex - 1, joc.childIndex - 1).value = joc.value
Next joc
Next job
.teardown
End With
End Sub
Public Sub testVillas()
' this is customized example
Dim a As Variant, i As Long
' multiple queries can be specified in the same query
a = Split(InputBox(prompt:="Enter destination (can be comma separated list)", _
title:="Destination villas will go to villas sheet"), ",")
For i = LBound(a) To UBound(a)
' we'll be appending multiple queries, and stamping a column with the query
With restQuery("villas", "villas", CStr(a(i)), , , , , , , , , , , , i <> LBound(a), "stamp")
.teardown
End With
Next i
End Sub
Public Sub testTwitter()
generalQuery("tweets", "twitter", _
InputBox(prompt:="Enter your twitter search query", _
title:="twitter API query:results to the tweets worksheet")).teardown
End Sub
Public Sub testeSim()
generalQuery("e-sim", "e-sim", _
InputBox(prompt:="Enter your e-sim ID", _
title:="e-sim results to the e-sim sheet")).teardown
End Sub
Public Sub testOpenCorporates()
generalQuery("opencorporates", "opencorporates reconcile", _
InputBox(prompt:="Enter your openCorporates search query", _
title:="openCorporates API query:results to the opencorporates worksheet")).teardown
End Sub
Public Sub testtweetsentimentdetails()
generalQuery("tweetsentimentdetails", "tweetsentiment details", _
InputBox(prompt:="Enter your tweet sentinment topic query", _
title:="tweetsentiments results to the tweets worksheet")).teardown
End Sub
Public Sub testtweetsentimentdetails2()
generalQuery("tweet2", "tweetsentiment details", _
InputBox(prompt:="Enter your tweet sentinment topic query", _
title:="tweetsentiments results to the tweets worksheet")).teardown
End Sub
Public Sub testItunesMovie()
generalQuery("itunesmovie", "itunes movie", _
InputBox(prompt:="Enter your itunes movie search query (eg. artist name)", _
title:="itunes API query:results to the itunesmovie worksheet")).teardown
End Sub
Public Sub testGoogleFinance()
With generalReport(restQuery _
("googlefinance", "google finance", , "ticker", , , , , False) _
, True)
.teardown
End With
End Sub
Public Sub xx()
Dim ds As New cDataSet
With ds.load("googlefinance")
.teardown
End With
End Sub
Public Sub testF1()
generalReport(restQuery("f1", "f1", 1000, , , , , , , , True) _
, True).teardown
End Sub
Public Sub testF1Drivers()
generalReport(restQuery("f1Drivers", "f1 drivers", 1000, , , , , , , , True) _
, True).teardown
End Sub
Public Sub TestWeatherXML()
' this will test the format=auto option for xml input
With generalDataSetQuery("weather", "open weather xml", "place")
.teardown
End With
End Sub
Public Sub TestFundsXML()
' this will test the format=auto option for xml input
With restQuery("funds", "funds", , , , , , , , , True, , "xxx", "xxx")
.teardown
End With
End Sub
Public Sub testWhatTheTrend()
generalReport(restQuery _
("whatthetrend", "whatthetrend", 1000, , , , , , , , True) _
, True).teardown
End Sub
Public Sub testPatents()
generalQuery("patent", "google patents", _
InputBox(prompt:="Enter your patent search query", _
title:="Google Patent API query:results to the Patent worksheet")).teardown
End Sub
Public Sub testOneOff()
Dim cr As cRest
Set cr = restQuery("patent", , "excel", , _
"https://ajax.googleapis.com/ajax/services/search/patent?v=1.0&rsz=8&q=", _
"responseData.results", False)
cr.teardown
End Sub
Public Sub testNoPop()
Dim cr As cRest, jo As cJobject
Set cr = restQuery("Geocoding", "yahoo geocode", , "input address", , , , False)
If Not cr Is Nothing Then
For Each jo In cr.jObjects
Debug.Print jo.serialize(True)
Next jo
End If
cr.teardown
End Sub
Public Sub teststatWikiHead()
Dim cr As cRest, jo As cJobject, ds As cDataSet, s As String, r As Range
Dim job As cJobject
s = InputBox(prompt:="Enter your date for example 201205", _
title:="statwiki date parameter") & "/json"
' get the data but dont populate- the keys are also data in this example
Set cr = restQuery("statwiki", "statwiki", s, , , , , False)
If (Not cr Is Nothing) Then
' first create a couple of headings
Set r = cr.dset.headingRow.where
r.Worksheet.Cells.ClearContents
r.Cells(1, 1).value = "Date"
r.Cells(1, 2).value = "Count"
' now populate
For Each job In cr.jObjects
With job.find(cr.datajObject.key())
For Each jo In .children
Set r = r.Offset(1)
r.Cells(1, 1).value = jo.key()
r.Cells(1, 2) = jo.value
Next jo
End With
Next job
End If
cr.teardown
End Sub
Public Sub testcrdirect()
Dim cr As New cRest, dset As New cDataSet
cr.init("responseData.results", erSingleQuery, , , _
dset.populateData(wholeSheet("patent"), , "patent", , , , True), , _
"https://ajax.googleapis.com/ajax/services/search/patent?v=1.0&rsz=8&q=", _
, False).execute "excel"
cr.teardown
End Sub
Public Sub testIMDBoneline()
Dim cr As New cRest
restQuery("imdb", , , "title", _
"http://www.imdbapi.com/?tomatoes=true&t=", , False).teardown
End Sub
Public Function testCombineFinanceSentiment() As cRest
Dim dr As cDataRow, Cc As cCell, cr As cRest, t As Date
'get the ticker data
generalReport(restQuery _
("investbysentiments", "google finance", , "ticker", , , , , False) _
, False).teardown
'add the tweet sentiments
Set cr = generalReport(restQuery _
("investbysentiments", "tweetsentiment topics", , "topic", , , , , False) _
, False)
'add the topsy counts
Set cr = generalReport(restQuery _
("investbysentiments", "topsy count", , "topic", , , , , False) _
, False)
t = Now()
With cr.dset.column("timestamp")
For Each Cc In .rows
Cc.value = t
Next Cc
End With
cr.dset.bigCommit
cr.teardown
End Function
Private Sub moveToBucket(Optional bCleanAfter As Boolean = True)
Dim ds As cDataSet, dsb As cDataSet, w As Range
Set ds = New cDataSet
' get the currently populated stuff
With ds
.populateData wholeSheet("investbysentiments"), , , , , , True
End With
' get the current bucket
Set dsb = New cDataSet
With dsb
.populateData wholeSheet("investbysentimentsbucket"), , , , , , True
' assume columns are all the same and just to a big commit
Set w = .where
If w Is Nothing Then
Set w = .headingRow.where.Offset(1)
Else
Set w = .where.Offset(.rows.count)
End If
ds.bigCommit w.Resize(1, 1), , , , , , False
If bCleanAfter Then
ds.where.ClearContents
End If
End With
ds.teardown
dsb.teardown
End Sub
Public Sub testandbucket()
testCombineFinanceSentiment
moveToBucket False
pivotCacheRefreshAll
End Sub
Public Sub Schedulethebucket()
'run once an hour
Dim pn As Date
pn = Now + TimeSerial(0, 20, 0)
Application.OnTime pn, "scheduledbucket"
End Sub
Public Sub scheduledbucket()
testandbucket
Schedulethebucket
End Sub
Private Sub messabout()
Dim jo As New cJobject, job As cJobject
Set job = jo.deSerialize( _
"[{'href':'http:\/\/en.wikipedia.org\/wiki\/Exploratory_Data_Analysis'," & _
"'description':'Exploratory data analysis - Wikipedia, the free Encyclopedia'," & _
"'extended':'','meta':'576e8bbed7ed3646da28523cc4cf0f73','hash':'8114ff56779cbce0c8cdeaedd21edab2'," & _
"'time':'2011-08-12T02:07:00Z','shared':'no','toread':'no','tags':'da-extended DA-source'}" _
)
Debug.Print job.serialize(True)
job.teardown
End Sub
Public Sub testGH()
Dim cr As cRest, jo As cJobject, Cc As cCell, r As Range, job As cJobject, joa As cJobject
Set cr = restQuery("gh", "GHStatListDB", , , , , , False, , , True)
' data comes back transposed with this one, so populate like below
If Not cr Is Nothing Then
With cr
For Each Cc In .dset.headings ' these are the required headings
Set r = .dset.headingRow.where.Resize(1, 1)
' this is a single query
Set jo = .jObject.find(Cc.toString)
Debug.Assert (Not jo Is Nothing) ' couldnt find the data for this column
For Each joa In jo.children
r.Offset(joa.childIndex, Cc.column - 1).value = joa.value
Next joa
Next Cc
End With
End If
cr.teardown
End Sub
Public Sub testAnalyticsData()
Dim cr As cRest, r As Range
Dim cj As cJobject, s As String, job As cJobject, sh As String, cb As cJobject
' you would do your restquery, and access the returned cr.jobject instead of this
Set cj = New cJobject
Set job = cj.init(Nothing).deSerialize(Range("fixed!a1").value)
' now we have the input data - need the column headers
' sheet name to write to
sh = "gaAnalytics"
wholeSheet(sh).Cells.ClearContents
Set r = firstCell(wholeSheet(sh))
' put the titles
With job.child("columnheaders")
For Each cj In .children
r.Offset(, cj.childIndex - 1).value = cj.child("name").toString
Next cj
End With
' get the data section
With job.child("rows")
For Each cj In .children
For Each cb In cj.children
r.Offset(cj.childIndex, cb.childIndex - 1).value = cb.value
Next cb
Next cj
End With
cr.teardown
job.teardown
End Sub
Public Sub testFooSon()
Dim testString As String
' case a)
' lets say we've already set up an entry in rest library called foobar
' and we've created a sheet called foosheet, with the headings we want from the data
' this would execute the query and populate the sheet (the .teardown cleans up afterwards)
''--- generalQuery("foosheet", "foobar", "somequeryparameter", True, True).tearDown
' case b)
' now, instead of getting the data from a web site, lets say we already have the json
testString = "{'fooson':" & _
"[ {'name':'first', 'id':0, 'decimal':7.8901, 'string':'foobar', 'date':'02/07/2013'}," & _
"{'name':'second', 'id':1, 'string':'bob', 'date':'12/25/2013', 'decimal':9.87654 }," & _
"{'name':'third', 'id':2, 'string':'snafu', 'decimal':1.2345, 'date':'07/04/2013'}," & _
"{'name':'fourth', 'id':3, 'date':'12/25/2012'} ]}"
restQuery("foosheet", "foobar", , , , , , , , , True, testString).teardown
' case c)
' now lets say we already have the json, but this time we want to deduce the headings
' this will only take the headings at first depth
Dim cj As cJobject, rout As Range, ds As cDataSet, ca As cJobject, job As cJobject
With restQuery("foosheet", "foobar", , , , , , False, , , True, testString)
' clear the sheet
wholeSheet("foosheet").Cells.ClearContents
' add the headings by getting every single key in the top level array
For Each job In .datajObject.children
For Each cj In job.children
' if we dont already have this heading then add it
If rout Is Nothing Then
Set rout = firstCell(wholeSheet("foosheet"))
rout.value = cj.key
Else
If (cleanFind(makeKey(cj.key), rout) Is Nothing) Then
Set rout = rout.Resize(, rout.columns.count + 1)
lastCell(rout).value = cj.key
End If
End If
Next cj
Next job
' now make a dataset of the headings
Set ds = New cDataSet
ds.populateData rout
'add the data values
For Each job In .datajObject.children
For Each cj In job.children
With ds.headingRow.exists(cj.key)
.where.Offset(job.childIndex).value = cj.value
End With
Next cj
Next job
' clear up dataset
ds.teardown
' clear up restquery
.teardown
End With
End Sub
Public Sub testOscar()
Dim jInput As String
jInput = Range("oscar!a1").value
restQuery("oscar!a2", , , , "foobar", "items", , True, , , True, jInput).teardown
End Sub
Public Sub testGoogaWire()
Dim jInput As String, cj As cJobject, r As Range, cd As cJobject
' for now, value is in a cell rather than from a rest query
' how to process google analytics
jInput = Range("googa!a1").value
With restQuery("googa!a2", , , , "foobar", "kind", , False, , , True, jInput)
' self defining columns in this response
Set r = .dset.headingRow.where.Resize(1, 1)
For Each cj In .jObject.child("columnheaders").children
r.Offset(, cj.childIndex - 1).value = cj.child("name").value
Next cj
' data rows have no labels
For Each cj In .jObject.child("rows").children
For Each cd In cj.children
r.Offset(cj.childIndex, cd.childIndex - 1).value = cd.value
Next cd
Next cj
.teardown
End With
End Sub
Public Sub testGoogaWireWithError()
Dim jInput As String, cj As cJobject, r As Range, cd As cJobject
' for now, value is in a cell rather than from a rest query
' how to process google analytics
jInput = Range("googaerror!a1").value
With restQuery("googa!a2", , , , "foobar", "kind", , False, , False, True, jInput)
If .jObject.childExists("error") Is Nothing Then
' self defining columns in this response
Set r = .dset.headingRow.where.Resize(1, 1)
For Each cj In .jObject.child("columnheaders").children
r.Offset(, cj.childIndex - 1).value = cj.child("name").value
Next cj
' data rows have no labels
For Each cj In .jObject.child("rows").children
For Each cd In cj.children
r.Offset(cj.childIndex, cd.childIndex - 1).value = cd.value
Next cd
Next cj
Else
' we can use crest to populate the error sheet
restQuery("googaError!a2", , , , "foobar", "errors", True, _
, , , True, .response).teardown
End If
.teardown
End With
End Sub
Private Function getFusionKey() As String
' this is my key - get your own..
getFusionKey = "AIzaSyB4smrtU7ZyaYl0s7SBuO9I7Iv4NzFezvQ"
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment