Forked from brucemcpherson/restlibraryexamples.vba
Created
December 13, 2013 09:30
-
-
Save shivswami/7941921 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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.15 | |
'--------------- | |
' 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 | |
'---------- | |
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 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 | |
jobHead.add k | |
End If | |
Set rescurseHeadersFromJob = jobHead | |
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 | |
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() | |
generalDataSetQuery("isbnq", "google books by isbn", "isbn").tearDown | |
End Sub | |
Public Sub testfreeGeoIP() | |
generalDataSetQuery("freegeoip", "freegeoip", "host").tearDown | |
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 Cc As cCell, ds As New cDataSet | |
With restQuery("dataout2", , , , "http://nowhere", "records", _ | |
True, , , , True, Range("jsonin!a2").value) | |
.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