So after having established the limits of ScriptControl and cscript.exe I feel the need to find a Javascript interoperability platform for VBA programmers. The ScriptControl can still parse JSON thanks to Douglas Crockford's scripts still being runnable on Ecmascript v.3 but other javascript libraries are already on Ecmascript v.6.
Javascript Web Service
So we need a new solution and Node.js is the answer. Here we give a simple webservice that takes a Javascript document, extracts some information and returns it. First, the javascript file, open Visual Studio 2017 with Node.js workload installed and open new Node.js console project and paste in the code below.
extractTitleAndUrl()
The extraction logic takes place in extractTitleAndUrl() and is expecting a document of a certain format (actually its a Google Sheets API format) and will extract two facts, title and url from each entry in an array. It adds these two facts to a new smaller object and places them in array. The array is stringified before returning. An error handler traps any problem but foes not give much information. You can see some test data for extractTitleAndUrl() commented out.
The Web Server
Everything that is not extractTitleAndUrl() is web server logic. I'll not explain too much of the plumbing here because other documentation does it better. In the requestHandler() we inspect the url to see if it has suffix '/extractTitleAndUrl' and if so run our logic otherwise print a hello world message. The body of the request is accumulated in chunks because Node.js splits these tasks into very small pieces so that code interleaves, this is the asynchronous model. Once the body is fully received then our logic extractTitleAndUrl() can be executed.
VBA client code is given below
'use strict';
const http = require('http');
const port = 80;
console.log('\nversion Juno\n');
const requestHandler = (request, response) => {
if (request.url == '/extractTitleAndUrl') {
//https://nodejs.org/en/docs/guides/anatomy-of-an-http-transaction/
let body = [];
request.on('data', (chunk) => {
body.push(chunk);
}).on('end', () => {
body = Buffer.concat(body).toString();
// at this point, `body` has the entire request body stored in it as a string
console.log('\nbody received:\n\n'+body);
var titleAndUrl = extractTitleAndUrl(body)
console.log('\nextracted title and url:\n\n' + titleAndUrl );
response.end(titleAndUrl);
});
} else {
console.log(request.url);
response.end('Hello Node.js Server!');
}
}
const server = http.createServer(requestHandler);
server.listen(port, (err) => {
if (err) {
return console.log('something bad happened', err);
}
console.log(`server is listening on ${port}`);
})
//var doc = {
// "feed": {
// "entry":
// [{ "title": { "$t": "1 Med" }, "link": [{ "href": "https//removed.1.Med.." }] },
// { "title": { "$t": "2 Dent" }, "link": [{ "href": "https//removed.2.Dent.." }] },
// { "title": { "$t": "3 Vet" }, "link": [{ "href": "https//removed.3.Vet.." }] }]
// }
//};
//console.log(JSON.stringify(extractTitleAndUrl(doc)));
function extractTitleAndUrl(text) {
try {
var doc = JSON.parse(text);
var newArray = new Array();
for (var i = 0; i < doc.feed.entry.length; i++) {
var newObj = new Object();
newObj['title'] = doc.feed.entry[i].title.$t;
if (doc.feed.entry[i].link.length = 1) {
newObj['url'] = doc.feed.entry[i].link[0].href;
} else {
newObj['url'] = doc.feed.entry[i].link[2].href;
}
newArray.push(newObj);
}
return JSON.stringify(newArray);
}
catch (ex) {
return ('#error in extractTitleAndUrl!');
}
}
Run the code with the Visual Studio start button, the following should be outputted
Debugger listening on ws://127.0.0.1:15347/1c2b4b25-fa9e-4690-b6a4-524b506491cb
For help see https://nodejs.org/en/docs/inspector
Debugger attached.
(node:5212) [DEP0062] DeprecationWarning: `node --inspect --debug-brk` is deprecated. Please use `node --inspect-brk` instead.
version Juno
server is listening on 80
...
VBA client code
The VBA code is given below. One point of note is that to stop cacheing it is necessary to use ServerXMLHTTP60 and not XMLHTTP60 re this StackOverflow response. The place to start execution is TestWebService(), press F5 there. This should return with the correct results but the console for Node.js should also output some messages...
...
server is listening on 80
body received:
{ "feed": {"entry": [ { "title": { "$t": "1 Med" }, "link": [ { "href": "https//removed...." } ] },
{ "title": { "$t": "2 Dent" }, "link": [ { "href": "https//removed...." } ] },
{ "title": { "$t": "3 Vet" }, "link": [ { "href": "https//removed...." }] }] } }
extracted title and url:
[{"title":"1 Med","url":"https//removed...."},{"title":"2 Dent","url":"https//removed...."},{"title":"3 Vet","url":"https//removed...."}]
Option Explicit
'* Tools->References
'MSScriptControl Microsoft Script Control 1.0 C:WindowsSysWOW64msscript.ocx
'MSXML2 Microsoft XML, v6.0 C:WindowsSysWOW64msxml6.dll
Private Function SC() As ScriptControl
Static soSC As ScriptControl
If soSC Is Nothing Then
Set soSC = New ScriptControl
soSC.Language = "JScript"
soSC.AddCode "function deleteValueByKey(obj,keyName) { delete obj[keyName]; } "
soSC.AddCode "function setValueByKey(obj,keyName, newValue) { obj[keyName]=newValue; } "
soSC.AddCode "function enumKeysToMsDict(jsonObj,msDict) { for (var i in jsonObj) { msDict.Add(i,0); } } "
soSC.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
soSC.AddCode "function JSON_stringify(value, replacer,spacer) { return JSON.stringify(value, replacer,spacer); } "
soSC.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "
End If
Set SC = soSC
End Function
Private Function GetJavaScriptLibrary(ByVal sURL As String) As String
Dim xHTTPRequest As MSXML2.XMLHTTP60
Set xHTTPRequest = New MSXML2.XMLHTTP60
xHTTPRequest.Open "GET", sURL, False
xHTTPRequest.send
GetJavaScriptLibrary = xHTTPRequest.responseText
End Function
Function SimpleMasterPage() As String
SimpleMasterPage = "{ ""feed"": {" & _
"""entry"": [ " & _
" { " & _
" ""title"": { ""$t"": ""1 Med"" }, " & _
" ""link"": [ { ""href"": ""https//removed...."" } ] " & _
" }, " & _
" { " & _
" ""title"": { ""$t"": ""2 Dent"" }, " & _
" ""link"": [ { ""href"": ""https//removed...."" } ] " & _
" }, " & _
" { " & _
" ""title"": { ""$t"": ""3 Vet"" }, " & _
" ""link"": [ { ""href"": ""https//removed...."" }] " & _
" }" & _
"] } }"
Dim objGutted2 As Object
Set objGutted2 = SC.Run("JSON_parse", SimpleMasterPage)
End Function
Sub TestWebService()
'* Do not use XMLHTTP60 because it caches!
'* https://stackoverflow.com/questions/5235464/how-to-make-microsoft-xmlhttprequest-honor-cache-control-directive#5386957
Dim vBody As Variant
vBody = SimpleMasterPage
Dim oXHR As MSXML2.ServerXMLHTTP60
Set oXHR = New MSXML2.ServerXMLHTTP60
oXHR.Open "POST", "http://localhost/extractTitleAndUrl"
oXHR.setRequestHeader "Cache-Control", "no-cache, no-store"
oXHR.send vBody
Debug.Print oXHR.responseText
Debug.Assert oXHR.responseText = "[{""title"":""1 Med"",""url"":""https//removed....""},{""title"":""2 Dent"",""url"":""https//removed....""},{""title"":""3 Vet"",""url"":""https//removed....""}]"
Stop
End Sub
