I'm trying to create a pattern for finding placeholders within a string to be able to replace them with variables later. I'm stuck on a problem to find all these placeholders within a string according to my requirement.
I already found this post, but it only helped a little:
Regex match ; but not \;
Placeholders will look like this
{&var} --> Variable stored in a dictionary --> dict("var")
{$prop} --> Property of a class cls.prop read by CallByName and PropGet
{#const} --> Some constant values by name from a function
Generally I have this pattern and it works well
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.pattern = "\{([#\$&])([\w\.]+)\}"
For example I have this string:
"Value of foo is '{&var}' and bar is '{$prop}'"
I get 2 matches as expected
(&)(var)
($)(prop)
I also want to add a formating part like in .Net to this expression.
String.Format("This is a date: {0:dd.mm.yyyy}", DateTime.Now());
// This is a date: 05.07.2019
String.Format("This is a date, too: {0:dd.(mm).yyyy}", DateTime.Now());
// This is a date, too: 05.(07).2019
I extended the RegEx to get that optional formatting string
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.pattern = "\{([#\$&])([\w\.]+):{0,1}([^\}]*)\}"
RegEx.Execute("Value of foo is '{&var:DD.MM.YYYY}' and bar is '{$prop}'")
I get 2 matches as expected
(&)(var)(DD.MM.YYYY)
($)(prop)()
At this point I noticed I have to take care for escapet "{" and "}", because maybe I want to have some brackets within the formattet result.
This does not work properly, because my pattern stops after "...{MM"
RegEx.Execute("Value of foo is '{&var:DD.{MM}.YYYY}' and bar is '{$prop}'")
It would be okay to add escape signs to the text before checking the regex:
RegEx.Execute("Value of foo is '{&var:DD.\{MM\}.YYYY}' and bar is '{$prop}'")
But how can I correctly add the negative lookbehind?
And second: How does this also works for variables, that should not be resolved, even if they have the correct syntax bus the outer bracket is escaped?
RegEx.Execute("This should not match '\{&var:DD.\{MM\}.YYYY\}' but this one '{&var:DD.\{MM\}.YYYY}'")
I hope my question is not confusing and someone can help me
Update 05.07.19 at 12:50
After the great help of #wiktor-stribiżew the result is completed.
As requested i provide some example code:
Sub testRegEx()
Debug.Print FillVariablesInText(Nothing, "Date\\\\{$var01:DD.\{MM\}.YYYY}\\\\ Var:\{$nomatch\}{$var02} Double: {#const}{$var01} rest of string")
End Sub
Function FillVariablesInText(ByRef dict As Dictionary, ByVal txt As String) As String
Const c_varPattern As String = "(?:(?:^|[^\\\n])(?:\\{2})*)\{([#&\$])([\w.]+)(?:\:([^}\\]*(?:\\.[^\}\\]*)*))?(?=\})"
Dim part As String
Dim snippets As New Collection
Dim allMatches, m
Dim i As Long, j As Long, x As Long, n As Long
' Create a RegEx object and execute pattern
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.pattern = c_varPattern
RegEx.MultiLine = True
RegEx.Global = True
Set allMatches = RegEx.Execute(txt)
' Start at position 1 of txt
j = 1
n = 0
For Each m In allMatches
n = n + 1
Debug.Print "(" & n & "):" & m.value
Debug.Print " [0] = " & m.SubMatches(0) ' Type [&$#]
Debug.Print " [1] = " & m.SubMatches(1) ' Name
Debug.Print " [2] = " & m.SubMatches(2) ' Format
part = "{" & m.SubMatches(0)
' Get offset for pre-match-string
x = 1 ' Index to Postion at least +1
Do While Mid(m.value, x, 2) <> part
x = x + 1
Loop
' Postition in txt
i = m.FirstIndex + x
' Anything to add to result?
If i <> j Then
snippets.Add Mid(txt, j, i - j)
End If
' Next start postition (not Index!) + 1 for lookahead-positive "}"
j = m.FirstIndex + m.Length + 2
' Here comes a function get a actual value
' e.g.: snippets.Add dict(m.SubMatches(1))
' or : snippets.Add Format(dict(m.SubMatches(1)), m.SubMatches(2))
snippets.Add "<<" & m.SubMatches(0) & m.SubMatches(1) & ">>"
Next m
' Any text at the end?
If j < Len(txt) Then
snippets.Add Mid(txt, j)
End If
' Join snippets
For i = 1 To snippets.Count
FillVariablesInText = FillVariablesInText & snippets(i)
Next
End Function
The function testRegEx gives me this result and debug print:
(1):e\\\\{$var01:DD.\{MM\}.YYYY(2):}{$var02
[0] = $
[1] = var02
[2] =
(1):e\\\\{$var01:DD.\{MM\}.YYYY
[0] = $
[1] = var01
[2] = DD.\{MM\}.YYYY
(2):}{$var02
[0] = $
[1] = var02
[2] =
(3): {#const
[0] = #
[1] = const
[2] =
(4):}{$var01
[0] = $
[1] = var01
[2] =
Date\\\\<<$var01>>\\\\ Var:\{$nomatch\}<<$var02>> Double: <<#const>><<$var01>> rest of string
You may use
((?:^|[^\\])(?:\\{2})*)\{([#$&])([\w.]+)(?::([^}\\]*(?:\\.[^}\\]*)*))?}
To make sure the consecutive matches are found, too, turn the last } into a lookahead, and when extracting matches just append it to the result, or if you need the indices increment the match length by 1:
((?:^|[^\\])(?:\\{2})*)\{([#$&])([\w.]+)(?::([^}\\]*(?:\\.[^}\\]*)*))?(?=})
^^^^^
See the regex demo and regex demo #2.
Details
((?:^|[^\\])(?:\\{2})*) - Group 1 (makes sure the { that comes next is not escaped): start of string or any char but \ followed with 0 or more double backslashes
\{ - a { char
([#$&]) - Group 2: any of the three chars
([\w.]+) - Group 3: 1 or more word or dot chars
(?::([^}\\]*(?:\\.[^}\\]*)*))? - an optional sequence of : and then Group 4:
[^}\\]* - 0 or more chars other than } and \
(?:\\.[^}\\]*)* - zero or more reptitions of a \-escaped char and then 0 or more chars other than } and \
} - a } char
Welcome to the site! If you need to only match balanced escapes, you will need something more powerful. If not --- I haven't tested this, but you could try replacing [^\}]* with [^\{\}]|\\\{|\\\}. That is, match non-braces and escaped brace sequences separately. You may need to change this depending on how you want to handle backslashes in your formatting string.
Is there any way to use named groups with regular expressions in VBA?
I would like to write a an Excel VBA Sub that matches the dates in file names and decrements these dates by a specified amount. I need to be able to distinguish between dd/mm and mm/dd formats -- among other irregularities -- and using named groups something like this would solve the problem:
(?:<month>\d\d)(?:<day>\d\d)
Advice is appreciated
Nope, no named groups in VBScript regular expressions.
VBScript uses the same regexp engine that JScript uses, so it's compatible with JavaScript regex, which also doesn't have named groups.
You have to use unnamed groups and just go by the order they appear on the expression to retrieve them by index after running it.
In general, dd/mm and mm/dd can't be automatically distinguished since there are valid dates that could be either. (e.g. 01/04 could be January 4th or April 1st). I don't think you'd be able to solve this with a regular expression.
Here is an implementation of named groups using VBA I made today. Hopefully this will be useful to someone else!:
'Description:
' An implementation of Regex which includes Named Groups
' and caching implemented in VBA
'Example:
' Dim match as Object
' set match = RegexMatch("01/01/2019","(?<month>\d\d)\/(?<day>\d\d)\/(?<year>\d\d\d\d)")
' debug.print match("day") & "/" & match("month") & "/" & match("year")
'Options:
' "i" = IgnoreCase
'Return value:
' A dictionary object with the following keys:
' 0 = Whole match
' 1,2,3,... = Submatch 1,2,3,...
' "Count" stores the count of matches
' "<<NAME>>" stores the match of a specified name
Function RegexMatch(ByVal haystack As String, ByVal pattern As String, Optional ByVal options As String) As Object
'Cache regexes for optimisation
Static CachedRegex As Object
Static CachedNames As Object
If CachedRegex Is Nothing Then Set CachedRegex = CreateObject("Scripting.Dictionary")
If CachedNames Is Nothing Then Set CachedNames = CreateObject("Scripting.Dictionary")
'Named regexp used to detect capturing groups and named capturing groups
Static NamedRegexp As Object
If NamedRegexp Is Nothing Then
Set NamedRegexp = CreateObject("VBScript.RegExp")
NamedRegexp.pattern = "\((?:\?\<(.*?)\>)?"
NamedRegexp.Global = True
End If
'If cached pattern doesn't exist, create it
If Not CachedRegex(pattern) Then
'Create names/capture group object
Dim testPattern As String, oNames As Object
testPattern = pattern
testPattern = Replace(testPattern, "\\", "asdasd")
testPattern = Replace(testPattern, "\(", "asdasd")
'Store names for optimisation
Set CachedNames(options & ")" & pattern) = NamedRegexp.Execute(testPattern)
'Create new VBA valid pattern
Dim newPattern As String
newPattern = NamedRegexp.Replace(pattern, "(")
'Create regexp from new pattern
Dim oRegexp As Object
Set oRegexp = CreateObject("VBScript.RegExp")
oRegexp.pattern = newPattern
'Set regex options
Dim i As Integer
For i = 1 To Len(flags)
Select Case Mid(flags, i, 1)
Case "i"
oRegexp.ignoreCase = True
Case "g"
oRegexp.Global = True
End Select
Next
'Store regex for optimisation
Set CachedRegex(options & ")" & pattern) = oRegexp
End If
'Get matches object
Dim oMatches As Object
Set oMatches = CachedRegex(options & ")" & pattern).Execute(haystack)
'Get names object
Dim CName As Object
Set CName = CachedNames(options & ")" & pattern)
'Create dictionary to return
Dim oRet As Object
Set oRet = CreateObject("Scripting.Dictionary")
'Fill dictionary with names and indexes
'0 = Whole match
'1,2,3,... = Submatch 1,2,3,...
'"Count" stores the count of matches
'"<<NAME>>" stores the match of a specified name
For i = 1 To CName.Count
oRet(i) = oMatches(0).Submatches(i - 1)
If Not IsEmpty(CName(i - 1).Submatches(0)) Then oRet(CName(i - 1).Submatches(0)) = oMatches(0).Submatches(i - 1)
Next i
oRet(0) = oMatches(0)
oRet("Count") = CName.Count
Set RegexMatch = oRet
End Function
P.S. for a Regex library (built by myself) which has this additional functionality, check out stdRegex. The equivalent can be done with:
set match = stdRegex.Create("(?:<month>\d\d)(?:<day>\d\d)").Match(sSomeString)
Debug.print match("month")
There are also more features of stdRegex, than VBScript's standard object. See the test suite for more info.
Thanks #Sancarn for his code!
For a few reasons I've revised it. The changes I've made are documented inside the code:
' Procedure for testing 'RegexMatch'.
' - It shows how to convert a date from 'mm/dd/yyyy' to 'dd.mm.yyyy' format.
' - It shows how to retrieve named groups by real name: 'Match.Item("group name")'
' as well as by number: 'Match.Items(group number)'.
' - It shows how to retrieve unnamed groups by number-generated name as well as by number.
' - It shows how to retrieve group count and the whole match by number-generated name as well as by number.
' - It shows that non-capturing groups like '(?:y)?' won't be listed.
' - It shows that left parenthesis inside a character class like '([x(])?' won't disturbe.
' Take notice of:
' - the small difference between 'Item' and 'Items'
' - the quotes in 'Match.Item("number of an unnamed group")'
Sub TestRegexMatch()
Dim Match As Scripting.Dictionary
Set Match = RegexMatch("01/23/2019z", "(?<month>\d\d)\/([x(])?(?<day>\d\d)\/(?:y)?(?<year>\d\d\d\d)(z)?")
Debug.Print Match.Item("day") & "." & Match.Item("month") & "." & Match.Item("year") & " vs. " & Match.Items(2) & "." & Match.Items(0) & "." & Match.Items(3)
Debug.Print "'" & Match.Item("1") & "'" & ", '" & Match.Item("4") & "' vs. '" & Match.Items(1) & "', '" & Match.Items(4) & "'"
Debug.Print Match.Item("98") & " vs. " & Match.Items(Match.Count - 2)
Debug.Print Match.Item("99") & " vs. " & Match.Items(Match.Count - 1)
End Sub
' An implementation of regex which includes named groups and caching implemented in VBA.
' The 'Microsoft VBScript Regular Expressions 5.5' library must be referenced (in VBA-editor: Tools -> References).
' Parameters:
' - haystack: the string the regex is applied on.
' - originalPattern: the regex pattern with or without named groups.
' The group naming has to follow .net regex syntax: '(?<group name>group content)'.
' Group names may contain the following characters: a-z, A-Z, _ (underscore).
' Group names must not be an empty string.
' - options: a string that may contain:
' - 'i' (the regex will work case-insensitive)
' - 'g' (the regex will work globally)
' - 'm' (the regex will work in multi-line mode)
' or any combination of these.
' Returned value: a Scripting.Dictionary object with the following entries:
' - Item 0 or "0", 1 or "1" ... for the groups content/submatches,
' following the convention of VBScript_RegExp_55.SubMatches collection, which is 0-based.
' - Item Match.Count - 2 or "98" for the whole match, assuming that the number of groups is below.
' - Item Match.Count - 1 or "99" for number of groups/submatches.
' Changes compared to the original version:
' - Handles non-capturing and positive and negative lookahead groups.
' - Handles left parenthesis inside a character class.
' - Named groups do not count twice.
' E.g. in the original version the second named group occupies items 3 and 4 of the returned
' dictionary, in this revised version only item 1 (item 0 is the first named group).
' - Additional 'm' option.
' - Fixed fetching cached regexes.
' - Early binding.
' - Some code cleaning.
' For an example take a look at the 'TestRegexMatch' procedure above.
Function RegexMatch(ByVal haystack As String, ByVal originalPattern As String, Optional ByVal options As String) As Scripting.Dictionary
Dim GroupsPattern As String
Dim RealPattern As String
Dim RealRegExp As VBScript_RegExp_55.RegExp
Dim RealMatches As VBScript_RegExp_55.MatchCollection
Dim ReturnData As Scripting.Dictionary
Dim GroupNames As VBScript_RegExp_55.MatchCollection
Dim Ctr As Integer
' Cache regexes and group names for optimisation.
Static CachedRegExps As Scripting.Dictionary
Static CachedGroupNames As Scripting.Dictionary
' Group 'meta'-regex used to detect named and unnamed capturing groups.
Static GroupsRegExp As VBScript_RegExp_55.RegExp
If CachedRegExps Is Nothing Then Set CachedRegExps = New Scripting.Dictionary
If CachedGroupNames Is Nothing Then Set CachedGroupNames = New Scripting.Dictionary
If GroupsRegExp Is Nothing Then
Set GroupsRegExp = New VBScript_RegExp_55.RegExp
' Original version: GroupsRegExp.Pattern = "\((?:\?\<(.*?)\>)?"
GroupsRegExp.Pattern = "\((?!(?:\?:|\?=|\?!|[^\]\[]*?\]))(?:\?<([a-zA-Z0-9_]+?)>)?"
GroupsRegExp.Global = True
End If
' If the pattern isn't cached, create it.
If Not CachedRegExps.Exists("(" & options & ")" & originalPattern) Then
' Prepare the pattern for retrieving named and unnamed groups.
GroupsPattern = Replace(Replace(Replace(Replace(originalPattern, "\\", "X"), "\(", "X"), "\[", "X"), "\]", "X")
' Store group names for optimisation.
CachedGroupNames.Add "(" & options & ")" & originalPattern, GroupsRegExp.Execute(GroupsPattern)
' Create new VBScript regex valid pattern and set regex for this pattern.
RealPattern = GroupsRegExp.Replace(originalPattern, "(")
Set RealRegExp = New VBScript_RegExp_55.RegExp
RealRegExp.Pattern = RealPattern
' Set regex options.
For Ctr = 1 To Len(options)
Select Case Mid(options, Ctr, 1)
Case "i"
RealRegExp.IgnoreCase = True
Case "g"
RealRegExp.Global = True
Case "m"
RealRegExp.MultiLine = True
End Select
Next
' Store this regex for optimisation.
CachedRegExps.Add "(" & options & ")" & originalPattern, RealRegExp
End If
' Get matches.
Set RealMatches = CachedRegExps.Item("(" & options & ")" & originalPattern).Execute(haystack)
' Get group names.
Set GroupNames = CachedGroupNames.Item("(" & options & ")" & originalPattern)
' Create dictionary to return.
Set ReturnData = New Scripting.Dictionary
' Fill dictionary with names and indexes as descibed in the remarks introducing this procedure.
For Ctr = 1 To GroupNames.Count
If IsEmpty(GroupNames(Ctr - 1).SubMatches(0)) Then
ReturnData.Add CStr(Ctr - 1), RealMatches(0).SubMatches(Ctr - 1)
Else
ReturnData.Add GroupNames(Ctr - 1).SubMatches(0), RealMatches(0).SubMatches(Ctr - 1)
End If
Next
ReturnData.Add "98", RealMatches.Item(0)
ReturnData.Add "99", GroupNames.Count
' Return the result.
Set RegexMatch = ReturnData
End Function
For further improvement this code could be the base of a class module for replacement of the VBScript regex.
I am trying to consume a web service in VB6. The service - which I control - currently can return a SOAP/XML message or JSON. I am having a really difficult time figuring out if VB6's SOAP type (version 1) can handle a returned object - as opposed to simple types like string, int, etc. So far I cannot figure out what I need to do to get VB6 to play with returned objects.
So I thought I might serialize the response in the web service as a JSON string. Does a JSON parser exist for VB6?
Check out JSON.org for an up-to-date list (see bottom of main page) of JSON parsers in many different languages. As of the time of this writing, you'll see a link to several different JSON parsers there, but only one is for VB6/VBA (the others are .NET):
VB-JSON
When I tried to download the zip file, Windows said the data was corrupt. However, I was able to use 7-zip to pull the files out. It turns out that the main "folder" in the zip file isn't recognized as a folder by Windows, by 7-zip can see the contents of that main "folder," so you can open that up and then extract the files accordingly.
The actual syntax for this VB JSON library is really simple:
Dim p As Object
Set p = JSON.parse(strFormattedJSON)
'Print the text of a nested property '
Debug.Print p.Item("AddressClassification").Item("Description")
'Print the text of a property within an array '
Debug.Print p.Item("Candidates")(4).Item("ZipCode")
Note: I had to add the "Microsoft Scripting Runtime" and "Microsoft ActiveX Data Objects 2.8" library as references via Tools > References in the VBA editor.
Note: VBJSON code is actually based on a google code project vba-json. However, VBJSON promises several bug fixes from the original version.
Building on ozmike solution, which did not work for me (Excel 2013 and IE10).
The reason is that I could not call the methods on the exposed JSON object.
So its methods are now exposed through functions attached to a DOMElement.
Didn't know this is possible (must be that IDispatch-thing), thank you ozmike.
As ozmike stated, no 3rd-party libs, just 30 lines of code.
Option Explicit
Public JSON As Object
Private ie As Object
Public Sub initJson()
Dim html As String
html = "<!DOCTYPE html><head><script>" & _
"Object.prototype.getItem=function( key ) { return this[key] }; " & _
"Object.prototype.setItem=function( key, value ) { this[key]=value }; " & _
"Object.prototype.getKeys=function( dummy ) { keys=[]; for (var key in this) if (typeof(this[key]) !== 'function') keys.push(key); return keys; }; " & _
"window.onload = function() { " & _
"document.body.parse = function(json) { return JSON.parse(json); }; " & _
"document.body.stringify = function(obj, space) { return JSON.stringify(obj, null, space); }" & _
"}" & _
"</script></head><html><body id='JSONElem'></body></html>"
Set ie = CreateObject("InternetExplorer.Application")
With ie
.navigate "about:blank"
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
.Visible = False
.document.Write html
.document.Close
End With
' This is the body element, we call it JSON:)
Set JSON = ie.document.getElementById("JSONElem")
End Sub
Public Function closeJSON()
ie.Quit
End Function
The following test constructs a JavaScript Object from scratch, then stringifies it.
Then it parses the object back and iterates over its keys.
Sub testJson()
Call initJson
Dim jsObj As Object
Dim jsArray As Object
Debug.Print "Construction JS object ..."
Set jsObj = JSON.Parse("{}")
Call jsObj.setItem("a", 1)
Set jsArray = JSON.Parse("[]")
Call jsArray.setItem(0, 13)
Call jsArray.setItem(1, Math.Sqr(2))
Call jsArray.setItem(2, 15)
Call jsObj.setItem("b", jsArray)
Debug.Print "Object: " & JSON.stringify(jsObj, 4)
Debug.Print "Parsing JS object ..."
Set jsObj = JSON.Parse("{""a"":1,""b"":[13,1.4142135623730951,15]}")
Debug.Print "a: " & jsObj.getItem("a")
Set jsArray = jsObj.getItem("b")
Debug.Print "Length of b: " & jsArray.getItem("length")
Debug.Print "Second element of b: "; jsArray.getItem(1)
Debug.Print "Iterate over all keys ..."
Dim keys As Object
Set keys = jsObj.getKeys("all")
Dim i As Integer
For i = 0 To keys.getItem("length") - 1
Debug.Print keys.getItem(i) & ": " & jsObj.getItem(keys.getItem(i))
Next i
Call closeJSON
End Sub
outputs
Construction JS object ...
Object: {
"a": 1,
"b": [
13,
1.4142135623730951,
15
]
}
Parsing JS object ...
a: 1
Length of b: 3
Second element of b: 1,4142135623731
Iterate over all keys ...
a: 1
b: 13,1.4142135623730951,15
As Json is nothing but strings so it can easily be handled if we can manipulate it the right way, no matter how complex the structure is. I don't think it is necessary to use any external library or converter to do the trick. Here is an example where I've parsed json data using string manipulation.
Sub GetJsonContent()
Dim http As New XMLHTTP60, itm As Variant
With http
.Open "GET", "http://jsonplaceholder.typicode.com/users", False
.send
itm = Split(.responseText, "id"":")
End With
x = UBound(itm)
For y = 1 To x
Cells(y, 1) = Split(Split(itm(y), "name"": """)(1), """")(0)
Cells(y, 2) = Split(Split(itm(y), "username"": """)(1), """")(0)
Cells(y, 3) = Split(Split(itm(y), "email"": """)(1), """")(0)
Cells(y, 4) = Split(Split(itm(y), "street"": """)(1), """")(0)
Next y
End Sub
Hopefully this will be a big help to others who keep on coming to this page after searching for "vba json".
I found this page to be very helpful. It provides several Excel-compatible VBA classes that deal with processing data in JSON format.
VBA-JSON by Tim Hall, MIT licensed and on GitHub. It's another fork of vba-json that emerged end of 2014. Claims to work on Mac Office and Windows 32bit and 64bit.
UPDATE: Found a safer way of parsing JSON than using Eval, this blog post shows the dangers of Eval ... http://exceldevelopmentplatform.blogspot.com/2018/01/vba-parse-json-safer-with-jsonparse-and.html
Late to this party but sorry guys but by far the easiest way is to use Microsoft Script Control. Some sample code which uses VBA.CallByName to drill in
'Tools->References->
'Microsoft Script Control 1.0; {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx
Private Sub TestJSONParsingWithCallByName()
Dim oScriptEngine As ScriptControl
Set oScriptEngine = New ScriptControl
oScriptEngine.Language = "JScript"
Dim sJsonString As String
sJsonString = "{'key1': 'value1' ,'key2': { 'key3': 'value3' } }"
Dim objJSON As Object
Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")
Debug.Assert VBA.CallByName(objJSON, "key1", VbGet) = "value1"
Debug.Assert VBA.CallByName(VBA.CallByName(objJSON, "key2", VbGet), "key3", VbGet) = "value3"
End Sub
I have actually done a series of Q&As which explore JSON/VBA related topics.
Q1 In Excel VBA on Windows, how to mitigate issue of dot syntax traversal of parsed JSON broken by IDE's capitalisation behaviour?
Q2 In Excel VBA on Windows, how to loop through a JSON array parsed?
Q3 In Excel VBA on Windows, how to get stringified JSON respresentation instead of “[object Object]” for parsed JSON variables?
Q4 In Windows Excel VBA,how to get JSON keys to pre-empt “Run-time error '438': Object doesn't support this property or method”?
Q5 In Excel VBA on Windows, for parsed JSON variables what is this JScriptTypeInfo anyway?
Here is a "Native" VB JSON library.
It is possible to use JSON that is already in IE8+. This way your not dependent on a third party library that gets out of date and is untested.
see amedeus' alternative version here
Sub myJSONtest()
Dim oJson As Object
Set oJson = oIE_JSON() ' See below gets IE.JSON object
' using json objects
Debug.Print oJson.parse("{ ""hello"": ""world"" }").hello ' world
Debug.Print oJson.stringify(oJson.parse("{ ""hello"": ""world"" }")) ' {"hello":"world"}
' getting items
Debug.Print oJson.parse("{ ""key1"": ""value1"" }").key1 ' value1
Debug.Print oJson.parse("{ ""key1"": ""value1"" }").itemGet("key1") ' value1
Debug.Print oJson.parse("[ 1234, 4567]").itemGet(1) ' 4567
' change properties
Dim o As Object
Set o = oJson.parse("{ ""key1"": ""value1"" }")
o.propSetStr "key1", "value\""2"
Debug.Print o.itemGet("key1") ' value\"2
Debug.Print oJson.stringify(o) ' {"key1":"value\\\"2"}
o.propSetNum "key1", 123
Debug.Print o.itemGet("key1") ' 123
Debug.Print oJson.stringify(o) ' {"key1":123}
' add properties
o.propSetNum "newkey", 123 ' addkey! JS MAGIC
Debug.Print o.itemGet("newkey") ' 123
Debug.Print oJson.stringify(o) ' {"key1":123,"newkey":123}
' assign JSON 'objects' to properties
Dim o2 As Object
Set o2 = oJson.parse("{ ""object2"": ""object2value"" }")
o.propSetJSON "newkey", oJson.stringify(o2) ' set object
Debug.Print oJson.stringify(o) ' {"key1":123,"newkey":{"object2":"object2value"}}
Debug.Print o.itemGet("newkey").itemGet("object2") ' object2value
' change array items
Set o = oJson.parse("[ 1234, 4567]") '
Debug.Print oJson.stringify(o) ' [1234,4567]
Debug.Print o.itemGet(1)
o.itemSetStr 1, "234"
Debug.Print o.itemGet(1)
Debug.Print oJson.stringify(o) ' [1234,"234"]
o.itemSetNum 1, 234
Debug.Print o.itemGet(1)
Debug.Print oJson.stringify(o) ' [1234,234]
' add array items
o.itemSetNum 5, 234 ' add items! JS Magic
Debug.Print o.itemGet(5) ' 234
Debug.Print oJson.stringify(o) ' [1234,234,null,null,null,234]
' assign JSON object to array item
o.itemSetJSON 3, oJson.stringify(o2) ' assign object
Debug.Print o.itemGet(3) '[object Object]
Debug.Print oJson.stringify(o.itemGet(3)) ' {"object2":"object2value"}
Debug.Print oJson.stringify(o) ' [1234,234,null,{"object2":"object2value"},null,234]
oIE_JSON_Quit ' quit IE, must shut down or the IE sessions remain.
Debug.Print oJson.stringify(o) ' can use after but but IE server will shutdown... soon
End Sub
You can bridge to IE.JSON from VB.
Create a function oIE_JSON
Public g_IE As Object ' global
Public Function oIE_JSON() As Object
' for array access o.itemGet(0) o.itemGet("key1")
JSON_COM_extentions = "" & _
" Object.prototype.itemGet =function( i ) { return this[i] } ; " & _
" Object.prototype.propSetStr =function( prop , val ) { eval('this.' + prop + ' = ""' + protectDoubleQuotes (val) + '""' ) } ; " & _
" Object.prototype.propSetNum =function( prop , val ) { eval('this.' + prop + ' = ' + val + '') } ; " & _
" Object.prototype.propSetJSON =function( prop , val ) { eval('this.' + prop + ' = ' + val + '') } ; " & _
" Object.prototype.itemSetStr =function( prop , val ) { eval('this[' + prop + '] = ""' + protectDoubleQuotes (val) + '""' ) } ; " & _
" Object.prototype.itemSetNum =function( prop , val ) { eval('this[' + prop + '] = ' + val ) } ; " & _
" Object.prototype.itemSetJSON =function( prop , val ) { eval('this[' + prop + '] = ' + val ) } ; " & _
" function protectDoubleQuotes (str) { return str.replace(/\\/g, '\\\\').replace(/""/g,'\\""'); }"
' document.parentwindow.eval dosen't work some versions of ie eg ie10?
IEEvalworkaroundjs = "" & _
" function IEEvalWorkAroundInit () { " & _
" var x=document.getElementById(""myIEEvalWorkAround"");" & _
" x.IEEval= function( s ) { return eval(s) } ; } ;"
g_JS_framework = "" & _
JSON_COM_extentions & _
IEEvalworkaroundjs
' need IE8 and DOC type
g_JS_HTML = "<!DOCTYPE html> " & _
" <script>" & g_JS_framework & _
"</script>" & _
" <body>" & _
"<script id=""myIEEvalWorkAround"" onclick=""IEEvalWorkAroundInit()"" ></script> " & _
" HEllo</body>"
On Error GoTo error_handler
' Create InternetExplorer Object
Set g_IE = CreateObject("InternetExplorer.Application")
With g_IE
.navigate "about:blank"
Do While .Busy: DoEvents: Loop
Do While .ReadyState <> 4: DoEvents: Loop
.Visible = False ' control IE interface window
.Document.Write g_JS_HTML
End With
Set objID = g_IE.Document.getElementById("myIEEvalWorkAround")
objID.Click ' create eval
Dim oJson As Object
'Set oJson = g_IE.Document.parentWindow.Eval("JSON") ' dosen't work some versions of IE
Set oJson = objID.IEEval("JSON")
Set objID = Nothing
Set oIE_JSON = oJson
Exit Function
error_handler:
MsgBox ("Unexpected Error, I'm quitting. " & Err.Description & ". " & Err.Number)
g_IE.Quit
Set g_IE = Nothing
End Function
Public Function oIE_JSON_Quit()
g_IE.Quit
Exit Function
End Function
Up vote if you find useful
VB6 - JsonBag, Another JSON Parser/Generator should also be importable into VBA with little trouble.
I would suggest using a .Net component. You can use .Net components from VB6 via Interop - here's a tutorial. My guess is that .Net components will be more reliable and better supported than anything produced for VB6.
There are components in the Microsoft .Net framework like DataContractJsonSerializer or JavaScriptSerializer. You could also use third party libraries like JSON.NET.
You could write an Excel-DNA Add-in in VB.NET. Excel-DNA is a thin library that lets you write XLLs in .NET. This way you get access to the entire .NET universe and can use stuff like http://james.newtonking.com/json - a JSON framework that deserializes JSON in any custom class.
If you are interested, here's a write up of how to build a generic Excel JSON client for Excel using VB.NET:
http://optionexplicitvba.com/2014/05/09/developing-a-json-excel-add-in-with-vb-net/
And here's the link to the code: https://github.com/spreadgit/excel-json-client/blob/master/excel-json-client.dna
Understand this is an old post, but I recently stumbled upon it while adding web service consumption to an old VB6 app. The accepted answer (VB-JSON) is still valid and appears to work. However, I discovered that Chilkat has been updated to include REST and JSON functionality, making it a one-stop (though paid) tool for me. They even have an online code generator that generates the code to parse pasted JSON data.
JsonObject link
Code Generator link
Whether you need it for VB6, VBA, VB.NET, C#, Delphi or pretty much any other programming language on the Windows platform, check JSON Essentials. Its capabilities go well beyond just parsing and querying JSON. Using JSON Essentials you can serialize objects into JSON, make JSON HTTP calls and get parsed JSON DOM in response if you need it, re-formatting JSON, using files, registry, memory streams, or HTTP/HTTPS for writing and loading JSON data in UTF-8/16/32 and ASCII/EASCII encodings, and it comes with JSON Schema support. On top of that it's exceptionally fast, stable, standard compliant, being actively developed and supported. And it has a free license too.
Here are some quick samples, the first one shows how to parse and query JSON:
' Create JSON document object.
Dim document As JsonDocument
Set document = New JsonDocument
' Parse JSON.
document.parse "{""a"":true,""b"":123,""c"":{},""d"":[""abc""]}"
' Select the first node of the 'd' node using JSON Pointer
' starting from the root document node.
Dim node_abc As IJsonNode
Set node_abc = document.root.select("/d/0")
' Select node 'a' starting from the previously selected
' first child node of node 'd' and traversing first up to
' the root node and then down to node 'a' using Relative
' JSON Pointer.
Dim node_a As IJsonNode
Set node_a = node_abc.select("rel:2/a")
The next one is about saving/loading a file:
' Load JSON from a UTF-16 file in the current directory
document.load "file://test.json", "utf-16"
' Save document to the current directory using UTF-8 encoding.
document.save "file://test.json", "utf-8"
That's how simple to make an HTTP JSON request using JSON Essentials:
' Load document from HTTP response.
Dim status As IJsonStatus
Set status = document.load("http://postman-echo.com/get")
And that's how to make complex HTTP JSON requests and and parse JSON responses:
' Create and fill a new document model object.
Dim model As SomeDocumentModel
Set model = New SomeDocumentModel
model.a = True
model.b = 123
Set model.c = New EmptyDocumentModel
model.d = Array("abc")
' Load JSON data from a document model object.
document.load model
Dim request As String
' Specify HTTP method explicitly.
request = "json://{" + _
"""method"" : ""PUT"","
' Add custom HTTP query parameters.
request = request + _
"""query"" : {" + _
"""a"" : ""#a""," + _
"""b"" : ""#b""," + _
"""c"" : ""#c""" + _
"},"
' Add custom HTTP form data parameters.
request = request + _
"""form"" : {" + _
"""d"" : ""#d""," + _
"""e"" : ""#e""," + _
"""f"" : ""#f""" + _
"},"
' Add custom HTTP headers.
request = request + _
"""form"" : {" + _
"""a"" : ""#1""," + _
"""b"" : ""#2""," + _
"""c"" : ""#3""" + _
"},"
' Override default TCP timeouts.
request = request + _
"""timeouts"" : {" + _
"""connect"" : 5000," + _
"""resolve"" : 5000," + _
"""send"" : 5000," + _
"""receive"" : 5000" + _
"},"
' Require response JSON document to contains HTTP response status code,
' HTTP response headers and HTTP response body nested as JSON.
request = request + _
"""response"" : {" + _
"""status"" : true," + _
"""headers"" : true," + _
"""body"" : ""json""" + _
"}" + _
"}"
' Save JSON document to the specified endpoint as HTTP PUT request
' that is encoded in UTF-8.
Dim status As IJsonStatus
Set status = document.save("http://postman-echo.com/put", "utf-8", request)
' Print JSON data of the parsed JSON response
Debug.Print status.response.json
And finally here's how to create a JSON Schema and perform JSON document validation:
' Create schema JSON document object.
Dim schemaDoc As JsonDocument
Set schemaDoc = New JsonDocument
' Load JSON schema that requires a node to be an array of numeric values.
schemaDoc.parse _
"{" + _
"""$id"": ""json:numeric_array""," + _
"""type"": ""array""," + _
"""items"": {" + _
"""type"": ""number""" + _
"}" + _
"}"
' Create schema collection and add the schema document to it.
Dim schemas As JsonSchemas
Set schemas = New JsonSchemas
Dim schema As IJsonSchema
Set schema = schemas.Add(schemaDoc, "json:numeric_array")
' Create JSON document object.
Dim instanceDoc As JsonDocument
Set instanceDoc = New JsonDocument
' Load JSON, an array of numeric values that is expected to
' satisfy schema requirements.
instanceDoc.load Array(0, 1, 2)
' Validate JSON instance document against the added schema.
Dim status As IJsonStatus
Set status = schema.validate(instanceDoc)
' Ensure the validation passed successfully.
Debug.Print IIf(status.success, "Validated", "Not-validated")
Using JavaScript features of parsing JSON, on top of ScriptControl, we can create a parser in VBA which will list each and every data point inside the JSON. No matter how nested or complex the data structure is, as long as we provide a valid JSON, this parser will return a complete tree structure.
JavaScript’s Eval, getKeys and getProperty methods provide building blocks for validating and reading JSON.
Coupled with a recursive function in VBA we can iterate through all the keys (up to nth level) in a JSON string. Then using a Tree control (used in this article) or a dictionary or even on a simple worksheet, we can arrange the JSON data as required.
Full VBA Code here.Using JavaScript features of parsing JSON, on top of ScriptControl, we can create a parser in VBA which will list each and every data point inside the JSON. No matter how nested or complex the data structure is, as long as we provide a valid JSON, this parser will return a complete tree structure.
JavaScript’s Eval, getKeys and getProperty methods provide building blocks for validating and reading JSON.
Coupled with a recursive function in VBA we can iterate through all the keys (up to nth level) in a JSON string. Then using a Tree control (used in this article) or a dictionary or even on a simple worksheet, we can arrange the JSON data as required.
Full VBA Code here.
Formula in an EXCEL CELL
=JSON2("{mykey:1111, mykey2:{keyinternal1:22.1,keyinternal2:22.2}, mykey3:3333}", "mykey2", "keyinternal2")
DISPLAYS: 22.2
=JSON("{mykey:1111,mykey2:2222,mykey3:3333}", "mykey2")
DISPLAYS: 2222
INSTRUCTIONS:
Step1. press ALT+F11
Step2. Insert -> Module
Step3. tools -> references -> tick Microsoft Script Control 1.0
Step4. paste this below.
Step5. ALT+Q close VBA window.
Tools -> References -> Microsoft Script Control 1.0; {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx
Public Function JSON(sJsonString As String, Key As String) As String
On Error GoTo err_handler
Dim oScriptEngine As ScriptControl
Set oScriptEngine = New ScriptControl
oScriptEngine.Language = "JScript"
Dim objJSON As Object
Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")
JSON = VBA.CallByName(objJSON, Key, VbGet)
Err_Exit:
Exit Function
err_handler:
JSON = "Error: " & Err.Description
Resume Err_Exit
End Function
Public Function JSON2(sJsonString As String, Key1 As String, Key2 As String) As String
On Error GoTo err_handler
Dim oScriptEngine As ScriptControl
Set oScriptEngine = New ScriptControl
oScriptEngine.Language = "JScript"
Dim objJSON As Object
Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")
JSON2 = VBA.CallByName(VBA.CallByName(objJSON, Key1, VbGet), Key2, VbGet)
Err_Exit:
Exit Function
err_handler:
JSON2 = "Error: " & Err.Description
Resume Err_Exit
End Function
this is vb6 example code, tested ok,works done
from the above good examples, i made changes and got this good result
it can read keys {} and arrays []
Option Explicit
'in vb6 click "Tools"->"References" then
'check the box "Microsoft Script Control 1.0";
Dim oScriptEngine As New ScriptControl
Dim objJSON As Object
''to use it
Private Sub Command1_Click()
Dim json$
json="{'key1': 'value1' ,'key2': { 'key3': 'value3' } }"
MsgBox JsonGet("key1", json) 'result = value1
json="{'key1': 'value1' ,'key2': { 'key3': 'value3' } }"
MsgBox JsonGet("key2.key3",json ) 'result = value3
json="{'result':[{'Bid':0.00004718,'Ask':0.00004799}]}"
MsgBox JsonGet("result.0.Ask", json) 'result = 0.00004799
json="{key1:1111, key2:{k1: 2222 , k2: 3333}, key3:4444}"
MsgBox JsonGet("key2.k1", json) 'result = 2222
json="{'usd_rur':{'bids':[[1111,2222],[3333,4444]]}}"
MsgBox JsonGet("usd_rur.bids.0.0", json) 'result = 1111
MsgBox JsonGet("usd_rur.bids.0.1", json) 'result = 2222
MsgBox JsonGet("usd_rur.bids.1.0", json) 'result = 3333
MsgBox JsonGet("usd_rur.bids.1.1", json) 'result = 4444
End Sub
Public Function JsonGet(eKey$, eJsonString$, Optional eDlim$ = ".") As String
Dim tmp$()
Static sJsonString$
On Error GoTo err
If Trim(eKey$) = "" Or Trim(eJsonString$) = "" Then Exit Function
If sJsonString <> eJsonString Then
sJsonString = eJsonString
oScriptEngine.Language = "JScript"
Set objJSON = oScriptEngine.Eval("(" + eJsonString + ")")
End If
tmp = Split(eKey, eDlim)
If UBound(tmp) = 0 Then JsonGet = VBA.CallByName(objJSON, eKey, VbGet): Exit Function
Dim i&, o As Object
Set o = objJSON
For i = 0 To UBound(tmp) - 1
Set o = VBA.CallByName(o, tmp(i), VbGet)
Next i
JsonGet = VBA.CallByName(o, tmp(i), VbGet)
Set o = Nothing
err: 'if key not found, result = "" empty string
End Function
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set objJSON = Nothing
Set oScriptEngine = Nothing
End Sub
Here is a new one: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support
It's a single self-contained module (no classes), parses JSON to nested built-in Collections (fast and lean) and supports practical subset of JSON Path (aka XPath for JSON) to retrieve values.
This means that there is no need to madly nest Item calls like
oJson.Item("first").Item("second").Item("array").Item(0)`
. . . but to access nested values can just use a single call to
JsonValue(oJson, "$.first.second.array[0]")
. . . and retrieve data from as deep in the hierarchy as needed.