This is the dbab JSON API for Database abstraction with google apps script, which is Mj61W-201_t_zC9fJg1IzYiz3TLx7pV4j. In JSON API for data abstraction classes I covered how to access the JSON API for Database abstraction with google apps script. Now let’s take it a stage further and write a fully fledged client for VBA that uses it.
Here’s a primer to introduce the concepts
Starting off
This uses the JSON API for data abstraction classes, so first you should read about that. The VBA API is simply a few classes that translate VBA into commands for JSON API for data abstraction classes. You should download the emptycdataset.xlsm from Downloads and if you want to do some tests, create a sheet called dbab. This will be used to load some test data in.
Since access to the API is protected by oauth2, first you’ll have to set up Excel to be able to talk oAuth2. Essentially this means creating a cloud project that can access Google Drive, and getting some client credentials. The one off sub in oAuth2Examples will set up your Excel to be able to automatically get and refresh access tokens when needed. The one off script looks like this and should contain your credentials from the cloud console.
Private Sub firstTimeOauth2() ' if you are calling for the first time ever you can either provide your ' clientid/clientsecret - or pass the the jsonparse retrieved from the google app console ' normally all this stuff comes from encrpted registry store ' change credentials to your own and run once ' in future, you can simply use getGoogled("scope") from any workbook 'or you can do first ever like this With getGoogled("drive", , xxx.apps.googleusercontent.com", "xxx") .tearDown End With End Sub
Next, you’ll set up your back end database(s). It’s easiest to start with creating a Google Workbook and using a sheet from that. Once you have it working, you can try some other back-ends.
There are 2 classes involved – cDbab and cDbabResult. These are used to issue API commands and decode the results. As with the google apps script version, it all starts with getting a handle depending on the type of back end database you are accessing. Here’s a small function to generalize the getting of a handle. This is using my copy of the starter script, so you should make your own copy and point at the published version, setting up your database credentials in the properties of your copy of the script.
Private Function setUpTest(dbtype As String, siloid As String, dbid As String) As cDbAb ' get authorized - using drive scope Dim oauth2 As cOauth2, handler As cDbAb Dim ds As cDataSet, testData As cJobject ' set up handler & set end point Set oauth2 = getGoogled("drive") Set handler = New cDbAb With handler.setOauth2(oauth2) .setEndPoint ("https://script.google.com/macros/s/AKfycbyfapkJpd4UOhiqLOJOGBb11nG4BTru_Bw8bZQ49eQSTfL2vbU/exec") .setDbId ("13ccFPXI0L8-ZViHlv8qoVspotUcnX8v0ZFeY4nUP574") .setNoCache (1) .setDbId (dbid) .setSiloId (siloid) .setDbName dbtype End With Set setUpTest = handler End Function
Now we have this, it’s simple to get a handler for any supported back-end. Here I’m getting 5 different kinds of back end databases and running the same unit tests on all of them. The only different for each database is these 3 parameters.
' set up handler & set end point Set handler = setUpTest("datastore", ds.name, "xliberationdatastore") lotsoftests handler, testData handler.tearDown Set handler = setUpTest("mongolab", ds.name, "xliberation") lotsoftests handler, testData handler.tearDown Set handler = setUpTest("parse", ds.name, "xliberation") lotsoftests handler, testData handler.tearDown Set handler = setUpTest("drive", ds.name, "/datahandler/driverdrive") lotsoftests handler, testData handler.tearDown Set handler = setUpTest("sheet", ds.name, "13ccFPXI0L8-ZViHlv8qoVspotUcnX8v0ZFeY4nUP574") lotsoftests handler, testData handler.tearDown
Getting some test data
I actually keep my test data in a Google Sheet somewhere, so I can do the same tests on Google Apps Script as I do in VBA. So i start off the testing session by querying that sheet from VBA and copying the data down to an Excel sheet – and of course, I’m using the dbab API to do that.
'get testdata from a google sheet & write it to an excel sheet testSheet = "dbab" Set handler = setUpTest("sheet", "customers", "13ccFPXI0L8-ZViHlv8qoVspotUcnX8v0ZFeY4nUP574") Set result = handler.query() assert result.handleCode >= 0, result.response, "getting testData from google sheet" Set ds = makeSheetFromJob(result.data, testSheet) Set testData = ds.jObject(, , , , "data")
Tests
These tests, which are the VBA version of the Google Apps Script tests referred to in Some test cases for various backends (which use the Database abstraction with google apps script library directly) look like this. There are many tests here, but I reproduce them so you can get a flavor of the various scenarios that can be handled. All this code can be found in the oauthexamples module of the emptycdataset.xlsm
Private Sub lotsoftests(handler As cDbAb, testData As cJobject) ' remove from last time Dim result As cDbAbResult, r2 As cDbAbResult Dim x As Long, job As cJobject Set result = handler.remove() Debug.Print "Starting " & handler.getDbName assert result.handleCode >= 0, result.response, "removing initial" ' save the new data Set result = handler.save(testData) assert result.handleCode >= 0, result.response, "saving initial" ' query and make sure it matches what was saved Set result = handler.query() assert Array(result.handleCode >= 0, result.count = testData.children.count), _ result.response, "querying initial" '--------query everything with limit Set result = handler.query(, "{'limit':2}") assert Array(result.handleCode >= 0, result.count = 2), _ result.response, "limit test(" & result.count & ")" '------Sort Reverse Set result = handler.query(, "{'sort':'-name'}") assert Array(result.handleCode >= 0, result.count = testData.children.count), _ result.response, "querysort(" & result.count & ")" '------Sort Reverse/skip Set result = handler.query(, "{'sort':'-name','skip':3}") assert Array(result.handleCode >= 0, result.count = testData.children.count - 3), _ result.response, "querysort+skip(" & result.count & ")" '------query simple nosql Set result = handler.query("{'name':'ethel'}") x = 0 For Each job In testData.children x = x + -1 * CLng(job.child("name").value = "ethel") Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "filterdot0(" & result.count & ")" '------query multi level Set result = handler.query("{'stuff':{'sex':'female'}}") x = 0 For Each job In testData.children x = x + -1 * CLng(job.child("stuff.sex").value = "female") Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "filter(" & result.count & ")" '------queries in Set result = handler.query("{'name':" & _ handler.constraints("[['IN',['ethel','fred']]]") & "}", , True) x = 0 For Each job In testData.children x = x + -1 * (job.toString("name") = "ethel" Or job.toString("name") = "fred") Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "filterdotc4 (" & result.count & ")" '------first complex constraints Set result = handler.query("{'stuff.age':" & _ handler.constraints("[['GT',25],['LTE',60]]") & "}") ' checking results kind of long winded in vba x = 0 For Each job In testData.children x = x + -1 * CLng(job.child("stuff.age").value > 25 And job.child("stuff.age").value <= 60) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "querying initial complex(" & result.count & ")" '------query single constraint Set result = handler.query("{'stuff':{'age':" & _ handler.constraints("[['GT',25]]") & "}}") x = 0 For Each job In testData.children x = x + -1 * CDbl(job.child("stuff.age").value > 25) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "filterdotc1 (" & result.count & ")" '------2 queries same constraint Set result = handler.query("{'stuff':{'age':" & _ handler.constraints("[['GT',25],['LT',60]]") & "}}") x = 0 For Each job In testData.children x = x + -1 * CDbl(job.child("stuff.age").value > 25 And job.child("stuff.age").value < 60) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "filterdotc2 (" & result.count & ")" '------2 queries same constraint Set result = handler.query("{'stuff':{'sex':'male', 'age':" & _ handler.constraints("[['GTE',25],['LT',60]]") & "}}", , True) x = 0 For Each job In testData.children x = x + -1 * (job.child("stuff.age").value >= 25 And job.child("stuff.age").value < 60 _ And job.child("stuff.sex").value = "male") Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "filterdotc3 (" & result.count & ")" '------queries in + Set result = handler.query( _ "{'name':" & handler.constraints("[['IN',['john','mary']]]") & _ ",'stuff.sex':'male','stuff.age':" & handler.constraints("[['GT',25]]") & "}") x = 0 For Each job In testData.children x = x + -1 * (job.child("stuff.sex").value = "male" And job.child("stuff.age").value > 25 And _ (job.toString("name") = "john" Or job.toString("name") = "mary")) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "filterdotc5 (" & result.count & "/" & x & ")" '------query single constraint, get keys Set result = handler.query( _ "{'stuff.age':" & handler.constraints("[['GT',25]]") & "}", _ "{'limit':1}", , True) x = 1 assert Array(result.handleCode >= 0, result.handleKeys.children.count = 1), _ result.response, "limitkeycheck1 (" & result.count & ")" '-------testing Get -- known as getobjects because get is reserved in vba Set r2 = handler.getObjects(result.handleKeys) x = 0 For Each job In r2.data.children x = x + -1 * CDbl(job.child("stuff.age").value > 25) Next job assert Array(r2.handleCode >= 0, r2.count = 1, x = r2.count), _ result.response, "get1 (" & r2.count & ")" '------retest constraint Set result = handler.query("{'stuff':{'age':" & _ handler.constraints("[['GT',60]]") & "}}") x = 0 For Each job In testData.children x = x + -1 * CDbl(job.child("stuff.age").value > 60) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "repeat test easy (" & result.count & ")" '------get ready for update test Set result = handler.query("{'stuff.sex':'male'}", , 1, 1) x = 0 For Each job In testData.children x = x + -1 * CDbl(job.child("stuff.sex").value = "male") Next job assert Array(result.handleCode >= 0, result.handleKeys.children.count = x), _ result.response, "does male work(" & result.count & ")" '----- do the update 'first update the data with a new field For Each job In result.data.children job.add "stuff.man", job.child("stuff.sex").value = "male" Next job ' now update it Set r2 = handler.update(result.handleKeys, result.data) assert Array(r2.handleCode = 0), _ r2.response, "update 2 (" & r2.count & ")" '------check previous query still works Set result = handler.query( _ "{'name':" & handler.constraints("[['IN',['john','mary']]]") & _ ",'stuff.sex':'male','stuff.age':" & handler.constraints("[['GT',25]]") & "}") x = 0 For Each job In testData.children x = x + -1 * (job.child("stuff.sex").value = "male" And job.child("stuff.age").value > 25 And _ (job.toString("name") = "john" Or job.toString("name") = "mary")) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "repeat test after update (" & result.count & "/" & x & ")" ' query again and make sure it matches what was saved Set result = handler.query() assert Array(result.handleCode >= 0, result.count = testData.children.count), _ result.response, "repeat querying initial" ' try counting Set result = handler.count() assert Array(result.handleCode >= 0, result.count = testData.children.count), _ result.response, "count 1" ' try complicated counting Set result = handler.count( _ "{'name':" & handler.constraints("[['IN',['john','mary']]]") & _ ",'stuff.sex':'male','stuff.age':" & handler.constraints("[['GT',25]]") & "}") x = 0 For Each job In testData.children x = x + -1 * (job.child("stuff.sex").value = "male" And job.child("stuff.age").value > 25 And _ (job.toString("name") = "john" Or job.toString("name") = "mary")) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "complex counting (" & result.count & "/" & x & ")" '--------------some more Set result = handler.query( _ "{ 'stuff.sex':'male','stuff.age':" & handler.constraints("[['GT',59]]") & "}") x = 0 For Each job In testData.children x = x + -1 * (job.child("stuff.sex").value = "male" And job.child("stuff.age").value >= 60) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "normal 0 (" & result.count & "/" & x & ")" '--------------make sure we're getting the right id with complex constaints Set result = handler.query( _ "{'stuff.age':" & handler.constraints("[['GT',25],['LTE',60]]") & "}") x = 0 For Each job In testData.children x = x + -1 * (job.child("stuff.age").value > 25 And job.child("stuff.age").value <= 60) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "repeat test constraint (" & result.count & "/" & x & ")" '--------------try OR Set result = handler.query( _ "[{'stuff.age':" & handler.constraints("[['LT',26]]") & ",'stuff.sex':'male'}," & _ "{'stuff.age':" & handler.constraints("[['GTE',60]]") & ",'stuff.sex':'male'}]") x = 0 For Each job In testData.children x = x + -1 * (job.child("stuff.sex").value = "male" And (job.child("stuff.age").value < 26 Or job.child("stuff.age").value >= 60)) Next job assert Array(result.handleCode >= 0, result.count = x), _ result.response, "OR 1 (" & result.count & "/" & x & ")" '------------show all the males Set r2 = handler.query("{'stuff.sex':'male'}", , 1, 1) x = 0 For Each job In testData.children x = x + -1 * CDbl(job.child("stuff.sex").value = "male") Next job assert Array(r2.handleCode >= 0, r2.handleKeys.children.count = x), _ r2.response, "show the males(" & r2.count & ")" '------------remove all the males Set result = handler.remove("{'stuff.sex':'male'}") assert Array(result.handleCode >= 0), _ result.response, "remove the males(" & result.count & ")" '-----------make sure they are gone Set result = handler.query() x = 0 For Each job In testData.children x = x + -1 * CDbl(job.child("stuff.sex").value <> "male") Next job assert Array(result.handleCode >= 0, result.handleKeys.children.count = x), _ result.response, "check after delete males(" & result.count & ")" '-----------add them back in Set result = handler.save(r2.data) assert Array(result.handleCode >= 0), _ result.response, "add them back(" & result.count & ")" '--------check they got added Set result = handler.query("{'stuff.man':true}") x = 0 For Each job In testData.children x = x + -1 * CDbl(job.child("stuff.sex").value = "male") Next job assert Array(result.handleCode >= 0, result.handleKeys.children.count = x), _ result.response, "check after adding them back(" & result.count & ")" '-------sort and save Set result = handler.query(, "{'sort':'-serial'}") assert Array(result.handleCode >= 0, result.count = testData.children.count), _ result.response, "sorting serial" '----- mark as good and save For Each job In result.data.children job.add "good", True Next job Set r2 = handler.save(result.data) assert Array(r2.handleCode >= 0), _ r2.response, "adding goods" '-------check we have twice th records Set result = handler.count() assert Array(result.handleCode >= 0, result.count = testData.children.count * 2), _ result.response, "doubled data" '------delete the ones we added Set result = handler.remove("{'good':true}") assert Array(result.handleCode >= 0), _ result.response, "doubled data" '------check original length Set result = handler.count() assert Array(result.handleCode >= 0, result.count = testData.children.count), _ result.response, "check final count" Debug.Print "Finished " & handler.getDbName End Sub
The Code
Here’s the code for the 2 classes
Option Explicit ' v1.0 ' this one manages interaction with dbAbstraction on Google Apps Script Private pDbId As String Private pSiloId As String Private pResult As cDbAbResult Private poAuth2 As cOauth2 Private pEndPoint As String Private pDbName As String Private pBrowser As cBrowser Private pNoCache As Long Private pPeanut As String Private pConstraints As cJobject Public Function constraints(json As String) As String ' for example 'stuff.age': handler.constraints("['GT' ,25],['LTE',60]]") ' needs to become 'stuff.age':{'__CONSTR$KEY$':[{'constraint':'$gt','value':25},{'constraint':'$lte','value':60}]} Dim s As cStringChunker, job As cJobject, jo As cJobject Set s = New cStringChunker Set job = JSONParse(json) s.add "{'__CONSTR$KEY$':[" For Each jo In job.children With s.add("{'value':") .add (maybeQuote(jo.children(2))) .add (",'constraint':'") .add(pConstraints.toString(jo.children(1).value)).add ("'") .add ("},") End With Next jo constraints = s.chopIf(",").add("]}").content End Function Private Function maybeQuote(jo As cJobject) As Variant Dim v As Variant If (jo.isArrayRoot) Then maybeQuote = jo.stringify Else v = jo.value If TypeName(v) = "string" Then maybeQuote = "'" & v & "'" Else maybeQuote = v End If End If End Function ' the endpoint - your Google Apps Script webapp url Public Function setEndPoint(endPoint As String) As cDbAb pEndPoint = endPoint Set setEndPoint = Me End Function Public Function getEndPoint() As String getEndPoint = pEndPoint End Function ' the result of the last fetch Public Function getResult() As cDbAbResult Set getResult = pResult End Function ' the siloid is roughly equivalent to a tablename Public Function setSiloId(id As String) As cDbAb pSiloId = id Set setSiloId = Me End Function Public Function getSiloId() As String getSiloId = pSiloId End Function ' this is the oauth2 object used to provide the accesstoken Public Function setOauth2(oauth2 As cOauth2) As cDbAb Set poAuth2 = oauth2 Set setOauth2 = Me End Function ' the dbid is roughtly equivalent to the database name Public Function setDbId(id As String) As cDbAb pDbId = id Set setDbId = Me End Function Public Function getDbId() As String getDbId = pDbId End Function ' any special id to use in google analytics when the api call is serviced Public Function setPeanut(id As String) As cDbAb pPeanut = id Set setPeanut = Me End Function Private Function getQueryString(Optional queryJSON As String = vbNullString) As String Dim queryOb As cJobject If (queryJSON <> vbNullString) Then Set queryOb = JSONParse(queryJSON) End If If (isSomething(queryOb)) Then getQueryString = "&query=" & URLEncode(queryOb.stringify) queryOb.teardown Else getQueryString = vbNullString End If End Function Private Function getParamString(Optional paramJSON As String = vbNullString) As String Dim paramOb As cJobject If (paramJSON <> vbNullString) Then Set paramOb = JSONParse(paramJSON) End If If (isSomething(paramOb)) Then getParamString = "¶ms=" & URLEncode(paramOb.stringify) paramOb.teardown Else getParamString = vbNullString End If End Function Private Function getAuthHeader() As String getAuthHeader = poAuth2.authHeader End Function ' the dbname is the name of the type of db .. eg SHEET Public Function setDbName(dbName As String) As cDbAb pDbName = dbName Set setDbName = Me End Function Public Function getDbName() As String getDbName = pDbName End Function Public Property Get browser() As cBrowser Set browser = pBrowser End Property Public Function setNoCache(noCache As Long) As cDbAb pNoCache = noCache Set setNoCache = Me End Function Private Function makeUrl(action As String, Optional noCache As Long = 0, Optional keepid As Boolean = False, _ Optional queryJSON As String = vbNullString, Optional paramsJSON As String = vbNullString) As String Dim s As New cStringChunker s.add(getEndPoint()) _ .add("?").add("driver=").add(getDbName()) _ .add("&").add("action=").add(action) _ .add("&").add("siloid=").add(getSiloId()) _ .add("&").add("dbid=").add(getDbId) _ .add("&").add("nocache=").add(CStr(noCache)) _ .add("&").add("keepid=").add(CLng(keepid) * -1) _ .add("&").add("peanut=").add(CStr(pPeanut)) _ .add(getQueryString(queryJSON)) _ .add getParamString(paramsJSON) makeUrl = s.content End Function ' dbabstraction save ' @param {cJobect} obs the data to save ' @return {cDbAbResult} the result Public Function save(obs As cJobject) As cDbAbResult Set save = execute("save", "POST", , , obs) End Function Public Function query(Optional queryJSON As String = vbNullString, _ Optional paramsJSON As String = vbNullString, _ Optional noCache As Long = 0, _ Optional keepid As Boolean = False) As cDbAbResult Set query = execute("query", "GET", queryJSON, paramsJSON, , , noCache, keepid) End Function Public Function update(keys As cJobject, obs As cJobject) As cDbAbResult Set update = execute("update", "POST", , , obs, keys, 1, 0) End Function Public Function remove(Optional queryJSON As String = vbNullString, _ Optional paramsJSON As String = vbNullString) As cDbAbResult Set remove = execute("remove", "POST", queryJSON, paramsJSON, , , 1, 0) End Function Public Function count(Optional queryJSON As String = vbNullString, _ Optional paramsJSON As String = vbNullString, _ Optional noCache As Long = 0) As cDbAbResult Set count = execute("count", "GET", queryJSON, paramsJSON, , , noCache, 0) End Function Public Function getObjects(keys As cJobject, Optional noCache As Long = 0, _ Optional keepid As Boolean = False) As cDbAbResult ' normally called get, but vba reserved name Set getObjects = execute("get", "POST", , , , keys, noCache, keepid) End Function Private Function execute(action As String, _ Optional method As String = "GET", _ Optional queryJSON As String = vbNullString, _ Optional paramsJSON As String = vbNullString, _ Optional data As cJobject = Nothing, _ Optional keys As cJobject = Nothing, _ Optional noCache As Long = 0, _ Optional keepid As Boolean = False) As cDbAbResult Dim result As String, payload As String, url As String, s As cStringChunker Set s = New cStringChunker If (pNoCache > 0) Then noCache = 1 url = makeUrl(action, noCache, keepid, queryJSON, paramsJSON) If (method = "GET") Then pBrowser.httpGET url, , , , , getAuthHeader(), , method Else If (isSomething(keys)) Then s.add (keys.stringify) If (isSomething(data)) Then s.chopIf("}").add(",").add (Mid(data.stringify, 2)) ElseIf (isSomething(data)) Then s.add (data.stringify) End If payload = s.content pBrowser.httpPost url, payload, True, getAuthHeader(), , method End If Set pResult = New cDbAbResult pResult.setResult pBrowser Set execute = pResult End Function Private Sub Class_Initialize() Set pBrowser = New cBrowser pNoCache = 0 pPeanut = getUserHash() Set pConstraints = JSONParse( _ "{'LT':'$lt','GTE':'$gte', 'GT':'$gt', 'NE':'$ne', 'IN':'$in','NIN':'$nin','EQ':'$eq','LTE':'$lte'}") End Sub Public Function teardown() If isSomething(pConstraints) Then pConstraints.teardown End If pBrowser.teardown If (isSomething(pResult)) Then pResult.teardown End If End Function cDbabResult.cls Option Explicit ' v1.10 ' this is a dbab result Private pResult As cJobject Public Property Get handleError() As String handleError = pResult.child("handleError").value End Property Public Property Get handleCode() As Long handleCode = pResult.child("handleCode").value End Property Public Property Get handleKeys() As cJobject Set handleKeys = pResult.child("handleKeys") End Property Public Property Get driverKeys() As cJobject Set driverKeys = pResult.child("driverKeys") End Property Public Property Get data() As cJobject Set data = pResult.child("data") End Property Public Property Get response() As cJobject Set response = pResult End Property Public Property Get length() As Long length = 0 If (isSomething(data)) Then length = data.children.count End If End Property Public Property Get count() As Long Dim c As cJobject count = 0 If (isSomething(data)) Then If (data.hasChildren) Then Set c = data.children(1).child("count") If (isSomething(c)) Then count = c.value Else count = length End If End If End If End Property Public Function setResult(browser As cBrowser) As cDbAbResult Set pResult = JSONParse(browser.Text, False) If (pResult Is Nothing) Then MsgBox ("invalid json data:" + browser.Text) End If Set setResult = Me End Function Public Function teardown() If (isSomething(pResult)) Then pResult.teardown End If End Function