Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
demo for how to use a variety of database backends, enabled by a google apps script backend, directly from VBA. for details see http://ramblings.mcpher.com/Home/excelquirks/dbapps/dbvariety
Option Explicit
' this is how to use Google Apps Script dbabstration web app from Excel.
' version 0.2
' http://ramblings.mcpher.com/Home/excelquirks/dbabstraction
' http://ramblings.mcpher.com/Home/excelquirks/googleoauth2 for how to set up yor pc for oauth2
Public Sub demoDBAccess()
Dim data As cJobject
Dim siloId As String, places As cJobject, place As cJobject, result As cJobject, _
sheetId, driveFolder As String, fusionId As String
'-- first get some test data from somewhere
'get some play data from importio
Set data = getSomePlayData
If (Not isResultGood(data)) Then
' for debugging - stop right away if we didnt connect
Debug.Print JSONStringify(data)
Debug.Assert False
End If
' load the test data to a sheet
Dim ds As New cDataSet
With ds.populateJSON(data.child("data"), firstCell(wholeSheet("importio")))
.tearDown
End With
'-- now read from the excel worksheet to populate a range of databases
Set ds = New cDataSet
Set data = ds.load("importio").jObject(, , , , "data")
ds.tearDown
' this is the key of the Google sheet Im using to play around with
sheetId = "12pTwh5Wzg0W4ZnGBiUI3yZY8QFoNI8NNx_oCPynjGYY"
' this is the table name i'll give it in all these places
siloId = "excelDemo"
' this is the folder I'll store the data in on google drive
driveFolder = "/datahandler/driverdrive"
' i want to create a new fusion table so I'll leave this blank
fusionId = ""
' use this object to control everything that needs to be done
' im not using oauth2 for any of these for demo
' for a real application you would copy the web app, lock it down as use oauth2
Set places = JSONParse("[" & _
"{'driver':'parse','siloid':'" & siloId & "','dbid':'" & siloId & "','oauth':false}," & _
"{'driver':'sheet','siloid':'" & siloId & "','dbid':'" & sheetId & "','oauth':false}," & _
"{'driver':'orchestrate','siloid':'" & siloId & "','dbid':'" & siloId & "','oauth':false}," & _
"{'driver':'drive','siloid':'" & siloId & "','dbid':'" & driveFolder & "','oauth':false}," & _
"{'driver':'fusion','siloid':'" & fusionId & "','dbid':'" & siloId & "','oauth':false}," & _
"{'driver':'scriptdb','siloid':'" & siloId & "','dbid':'" & siloId & "','oauth':false}" & _
"]")
' now do all the copying
For Each place In places.children
Set result = replaceSilo(place, data)
If (Not isResultGood(result)) Then
MsgBox ("failed " & result.stringify)
Else
Debug.Print "copied data to database " & place.toString("driver")
End If
Next place
' do some counts..
For Each place In places.children
Set result = dbExecute("count", place)
If (Not isResultGood(result)) Then
MsgBox ("failed counting" & result.stringify)
Else
Debug.Print "count for " & place.toString("driver") & " is " & result.child("data.1.count").value
End If
Next place
' recover memory
data.tearDown
End Sub
Private Function isResultGood(result As cJobject) As Boolean
isResultGood = False
If isSomething(result) Then
If (result.child("handleCode").value >= 0) Then
isResultGood = True
End If
End If
End Function
Private Function replaceSilo(place As cJobject, postData As cJobject) As cJobject
Dim result As cJobject
' delete current contents and replace by new data
Set result = dbExecute("remove", place)
' if that worked, then copy the new data in
If (isResultGood(result)) Then
' this could have created a new table, so store its id first and use it for subsequent operations
place.child("siloid").value = result.child("table").value
place.child("dbid").value = result.child("dbid").value
Set result = dbExecute("save", place, postData)
End If
Set replaceSilo = result
End Function
Private Function dbExecute(action As String, place As cJobject, Optional postData As cJobject = Nothing) As cJobject
Dim result As cJobject, data As cJobject
With restDbAccess(action, place.toString("driver"), place.toString("siloId"), _
place.toString("dbid"), , , postData, place.child("oauth").value)
If (Not .isOk) Then
MsgBox ("failed connection " & .status)
Else
Set result = JSONParse(.Text)
End If
.tearDown
End With
Set dbExecute = result
End Function
' this is the webApp url
Private Function getWebAppUrl() As String
' this will access my version of this.
' to access your own files you should make a copy to your own google account, with your own API keys for the various backends
' see http://ramblings.mcpher.com/Home/excelquirks/dbabstraction/restapi
' you can use oauth2 to lock it down
' see http://ramblings.mcpher.com/Home/excelquirks/googleoauth2
getWebAppUrl = "https://script.google.com/macros/s/AKfycbyNxrJg2SbjoKWJQgGxqjECkcA-A57xaoRQWzsJkTPbVyTWbCDi/exec" & _
"?source=excel&nocache=1"
End Function
' get some data to play with
Private Function getSomePlayData() As cJobject
' this will query some data from an import.io web scrape for some test data
Dim cb As New cBrowser, queryJob As cJobject, siloId As String
' the query
Set queryJob = JSONParse("{'searchterm': 'avengers 2'}")
' the id of the importio query
siloId = "caff10dc-3bf8-402e-b1b8-c799a77c3e8c"
With restDbAccess("query", "importio", siloId, "myimportio", queryJob)
If (Not .isOk) Then
MsgBox ("failed connection " & .status)
Else
Set getSomePlayData = JSONParse(.Text)
End If
' recover browser memory
.tearDown
End With
End Function
' do a rest query
Private Function restDbAccess(action As String, driver As String, siloId As String, _
Optional dbId As String, Optional queryJob As cJobject = Nothing, _
Optional queryParameters As cJobject = Nothing, _
Optional postData As cJobject = Nothing, _
Optional oauth As Boolean = False) As cBrowser
Dim cb As New cBrowser, t As cStringChunker, authHeader As String
Set t = New cStringChunker
' construct the url
With t.add(getWebAppUrl()).add("&action=").add(action)
.add("&driver=").uri(driver) _
.add("&siloid=").uri(siloId) _
.add("&dbid=").uri (dbId)
End With
' add any query & parameters
If (isSomething(queryJob)) Then t.add("&query=").uri (queryJob.stringify)
If (isSomething(queryParameters)) Then t.add("&params=").uri (queryParameters.stringify)
' see http://ramblings.mcpher.com/Home/excelquirks/googleoauth2 for how to set up yor pc for this
If oauth Then
With getGoogled("drive")
If .hasToken Then
authHeader = .authHeader
Else
MsgBox ("failed to authenticate: " & .denied)
Debug.Assert False
End If
.tearDown
End With
Else
authHeader = vbNullString
End If
' collect minimal usage stats
Dim UA As cUAMeasure
Set UA = registerUA("dbAbstraction_" & action & "_" & driver)
' if there's data use post, otherwise use get. the webapp works with either interchangeably
If (isSomething(postData)) Then
cb.httpPost t.toString, postData.stringify, True, authHeader
Else
cb.httpGET t.toString, , , , , authHeader
End If
Set restDbAccess = cb
'clear usage collecter
UA.postAppKill.tearDown
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment