Friday 25 May 2018

VBA - Strings and byte arrays are very fungible

I think I've used StrConv to convert strings to byte arrays and back in the past but actually the following code does as well.

'With thanks to user couttsj at vbforums.com
Public Function UniToByte(strInput As String) As Byte()
    UniToByte = strInput
End Function

Public Function ByteToUni(bArray() As Byte) As String
    ByteToUni = bArray
End Function

Try it from the Immediate Window

?ByteToUni(UniToByte("Hello"))
Hello

Monday 14 May 2018

VBA - MSXML2 uncompromising interface based programming can throw newbies

So on SO I have just written an answer for a self-professed VBA newbie concerning XML in VBA. Whilst writing the answer one has to judge how much information to pass on, too little does not help solve the problem, too much seems patronising and also one ought not recreate the documentation. But actually there is something about the MSXML2 library specifically which throws VBA newbies and a good blog post should explain what is happening.

COM and interface based programming

VBA is a COM (Microsoft Component Object Model) technology. COM is based on interface programming, every COM call executes via an interface and not directly on an object. Interface based programming advocates encourage polymorphism and breaking an object's identity into separate interfaces.

So for example one could have a banking application with business domain objects such as overdraft, mortgage, credit card. Interface based programming advocates would encourage the identification of a common interface for these objects and a separate interface to handle each object's idiosyncrasies.

Excel's Object Model hides default interfaces

But interface based programming can be confusing to newbies. Excel's object model is COM based and so uses interfaces but each Excel object typically has one default interface and VBA pulls a trick to make the calling the default interface look the same as calling the object. This sleight of hand by VBA is useful for productivity and helps quick scripting of the Excel object model but at some point the newbie might need to access Xml and use MSXML2 library when they may well be flummoxed at having to deal with interfaces.

So using the VBA Object Browser one can see many Excel classes such as Workbook, Worksheet, Application and Range and their methods so it looks like one is calling the objects. But if one uses OLEView.exe one can see that the underlying default interfaces are _Workbook, _Worksheet, _Application and IRange. Range does not exists as its own separate class but this is faked (along with others) some VBA programmers think they are dealing with an object.

Note how some interfaces begin with I, e.g. IRange.

What is a sideways cast?

If an object's functionality is broken down into more than one interface (as sometimes advocated) it becomes necessary to give a mechanism to hop from one interface to another on the same object. How is this interface hopping done in VBA? Answer, with a 'sideways cast'.

The code below is illustrative only, it won't run. It illustrates a sideways cast. The sideways cast is when one uses the Set keyword to equate one 'object variable' to another. But actually they are not 'object variables' but in fact interface variables.

Sub SidewaysCastIllustration()
    '* this is illustrative only, it won't run
    Dim oShape As IShape
    Set oShape = getShape("Square1")
    
    Dim oSquare As ISquare
    Set oSquare = oShape  '* <-- sideways cast take the object oShape and queries for interface ISquare 

End Sub

[For real geeks interested in what happens under the hood a sideways cast calls the QueryInterface method on the the canonical COM interface IUnknown but newbies need not concern themselves with this.]

MSXML2 is uncompromising interface based programming

When using MSXML2 to handle Xml in VBA one declares variables of interface types such as IXMLDOMNode, IXMLDOMElement and IXMLDOMAttribute. Note how they begin with I. Time for code to illustrate. The code at the bottom parses a mini Xml document and two parts, one element and one attribute, are retrieved from the document. Because the selection method SelectSingleNode can return elements or attributes it is defined to return a unifying interface IXMLDOMNode. To then access the details of the element one sideways casts from IXMLDOMNode to IXMLDOMElement.

This program shows Xml parsing with interface based programming and sideways casts to hop between interfaces on object.

Option Explicit

Sub Test()
    '* requires Tools->References->Microsoft XML, v6.0

    Dim sXml As String
    sXml = "<root><foo id='fooey'/><bar><baz>hi</baz></bar></root>"
    
    Dim oDom As MSXML2.DOMDocument60
    Set oDom = New MSXML2.DOMDocument60
    
    oDom.LoadXML sXml
    Debug.Assert oDom.parseError.ErrorCode = 0
    
    Dim oNode As MSXML2.IXMLDOMNode
    Set oNode = oDom.SelectSingleNode("root/foo/@id")

    '*
    '* to access the methods for interacting with an attribute
    '* one needs to "sideways cast" which queries for another interface
    '*
    Dim oAttrSidewaysCast As MSXML2.IXMLDOMAttribute
    Set oAttrSidewaysCast = oNode  '* <-- sideways cast from IXMLDOMNode to IXMLDOMAttribute 
    Debug.Print oAttrSidewaysCast.Value
    
    Set oNode = Nothing  '* reset the variable
    Set oNode = oDom.SelectSingleNode("root/bar/baz")

    '*
    '* to access the methods for interacting with an element
    '* one needs to "sideways cast" which queries for another interface
    '*
    Dim oElementSidewaysCast As MSXML2.IXMLDOMElement
    Set oElementSidewaysCast = oNode  '* <-- sideways cast from IXMLDOMNode to IXMLDOMElement 
    Debug.Print oElementSidewaysCast.nodeTypedValue

End Sub

Saturday 12 May 2018

Six things about Ruby

As an experienced VBA developer, Ruby sounds quite exotic, for Londoners a Ruby is slang for curry (Cockney rhyming slang - Ruby Murray -> Curry). I chose to research Ruby to see if it is a language worth learning and here are ten things I didn't know about Ruby which perhaps I should.

1. Ruby is Japanese. Ruby is a dynamic, reflective, object-oriented, general-purpose programming language. It was designed and developed in the mid-1990s by Yukihiro "Matz" Matsumoto in Japan. As such a lot of early documentation was only available in Japanese.

2. Ruby is very object-orientated with strong Smalltalk influences. I studied Smalltalk at university and it is very OO as is Ruby. In both Ruby and Smalltalk everything is an object and objects repond to messages. So even strings are objects. Want to know the length of a string in Ruby? Then send the string object the message 'length' by evaluating the expression

"HelloWorld".length

3. In Ruby, code blocks can be defined either with curly braces of with def|if|do..end keyword pairs. Some languages insist on curly braces to define code blocks whereas VBA (and others) use keyword pairs to delimit, e.g. If..Endif Sub..End Sub While..Wend . In Ruby you have the choice between the two. Example from wikipedia...

{ puts 'Hello, World!' } # note the braces
# or:
do
  puts 'Hello, World!'
end

4. Ruby has dangerous methods denoted by ! (bang) which mean an object's state can be modified. C# has the x++ increment operator which is short for x=x+1. So x++ doesn't just evaluate x+1 it modifies x as well. Ruby has dangerous methods which are similar and denoted with the ! bang symbol.


foo = "A STRING"  # a string called foo
foo.downcase      # returns "a string"

BUT

foo = "A STRING"  # a string called foo
foo.downcase!     # modifies foo to be "a string" permanently

Imagine how much typing you could save with this feature!

5. Ruby On Rails bears architectural similarities to ASP.NET

Most non-Ruby (i.e. Microsoft) programmers have heard of Ruby because of Ruby-On-Rails which is a web framework. What they might not know is that there is similarity to ASP.NET particularly its MVC variants. Ruby-On-Rails organises its project folders by models, views and controllers. Views, HTML, are rendered using string interpolation just like ASP.NET. There is an Object Relational Mapping (ORM) layer called ActiveRecord as a direct analogue to .NET's EntityFramework

6. Ruby Is Not Too Slow For Web-Scale

https://www.speedshop.co/2017/07/11/is-ruby-too-slow-for-web-scale.html

Miscellany


https://rosenfeld.herokuapp.com/en/articles/ruby-rails/2017-05-01-feeling-alone-in-the-ruby-community-and-replacing-rails-with-roda
https://rosenfeld.herokuapp.com/en/articles/ruby-rails/2017-05-03-ruby-on-rails-the-bad-and-good-parts
https://marketplace.visualstudio.com/items?itemName=rebornix.Ruby
file:///N:/Rails_on_MIcrosoft.pdf
https://www.ruby-lang.org/en/documentation/ruby-from-other-languages/
http://tryruby.org/levels/3/challenges/1
https://www.speedshop.co/2017/07/11/is-ruby-too-slow-for-web-scale.html
https://www.techempower.com/benchmarks/#section=data-r14&hw=ph&test=json


Matz

Saturday 5 May 2018

VBA - Windows - Code to see if exe is reachable with Path environment variable

I'm trying to run a program called midl.exe but it currently complains that it cannot find the program cl.exe which means I need to triage my Path environment variable so it can be reached. It occurred to me that it would be nice to mimic/predict Windows behaviour as it walks the directories of the Path environment variable. Luckily SO comes to the rescue and yields the PathFindOnPath windows api function.

We can write some client VBA code to call this WinApi function, here it is

Option Explicit

'// https://msdn.microsoft.com/en-us/library/bb773594%28VS.85%29.aspx
Declare Function PathFindOnPath Lib "SHLWAPI.DLL" Alias "PathFindOnPathA" (ByVal pszFile As String, ppszOtherDirs As String) As Long
'BOOL PathFindOnPath(
'  _Inout_  LPTSTR  pszFile,
'  _In_opt_ LPCTSTR *ppszOtherDirs
');

Function PathFindOnPathShim(ByVal pszFile As String, ByVal ppszOtherDirs As String, ByRef sResult As String) As Boolean
    Dim lRetval As Long, sBuffer As String
    
    sBuffer = Left$(pszFile & String$(256, vbNullChar), 256)
    
    lRetval = PathFindOnPath(sBuffer, ppszOtherDirs)
    If lRetval = 1 Then
        sResult = Mid$(sBuffer, 1, InStr(sBuffer, vbNullChar))
        PathFindOnPathShim = True
    Else
        sResult = ""
        PathFindOnPathShim = False
    End If
End Function


Sub TestPathFindOnPathShim()
    
    Dim sFile As String, sOtherDirs As String, sResult As String
    
    sFile = "cl.exe"
    sOtherDirs = "C:\Program Files (x86)\Microsoft Visual Studio 12.0\VC\bin"
    
    If PathFindOnPathShim(sFile, sOtherDirs, sResult) Then
        Debug.Print sResult
    Else
        Debug.Print "not reachable via %PATH%"
    End If

End Sub

Sub WritePathEnvToSheet()

    Dim sPath As String
    sPath = Environ$("PATH")
    
    Dim vSplit As Variant
    vSplit = VBA.Split(sPath, ";")
    
    Dim vPastable As Variant
    vPastable = Application.Transpose(vSplit)
    
    Sheet1.Cells(1, 1).Resize(UBound(vSplit) - LBound(vSplit) + 1, 1).Value2 = vPastable
    Stop


End Sub

Friday 4 May 2018

VBA - Use Square Brackets trick to prettify strings, especially code fragments

So I learnt all about using a trick to get square bracket syntax in VBA and how the argument is really a string but without the enclosing double quotes or the doubling of internal double quotes as is normally the case with VBA strings.

The following VBA code fragments below should demonstrate where and where not one could use this technique. The code relies on a ATL/C++ component the key sections of which are given at the bottom.

Sub TestSourceCode()

    '* SourceFragmentLib.Src is defined as Global


    '* plain string, note no doubling of double quotes
    Debug.Print Src.[he said "no", she said "yes"]
    
    '* sql statement much more readable without doubling of double quotes
    Debug.Print Src.[SELECT * FROM fooTable WHERE lastName="Devolio"]


End Sub

Let us not forget that Excel's Application object processes expressions in strings but one can still see the advantages of not having to double up double quotes, see this code which allows the evaluation of a string literal to be parsed into a variant array ready for pasting into a block of cells.


Sub XlSerialization1()
    Dim v
    v = [{1,2;"foo",4.5}]    '* this calls Application.Evaluate and parses to 2x2 variant array, note no doubling of double quotes

    '* write all cells in one line
    Sheet1.Cells(1, 1).Resize(2, 2).Value2 = v
End Sub

For regular expressions, this trick is less effective because square brackets are part of the regular expression symbol vocabulary. Here is an example, if only to illustrate that perhaps this is not a good use of this technique.

Sub TestRegularExpression()

    Dim oRE As VBScript_RegExp_55.RegExp    '* Tools->References: Microsoft VBScript Regular Expressions 5.5
    Set oRE = New VBScript_RegExp_55.RegExp
    
    '* following line avoids doubling double quotes
    '* (but regular expressions are cryptic anyhow!)
    oRE.Pattern = Src.["([^"]*)"]
    
    '* here is what it the expression looks like with doubling double quotes
    '* yuck!
    Debug.Assert oRE.Pattern = """([^""]*)"""
    
    oRE.Global = True
    
    Dim sTest As String
    sTest = """Foo Bar"" ""Another Value"" something else"

    Debug.Assert oRE.test(sTest)

    Dim oMatchCol As VBScript_RegExp_55.MatchCollection
    Set oMatchCol = oRE.Execute(sTest)
    Debug.Assert oMatchCol.Count = 2
    
    Dim oMatch As Match
    For Each oMatch In oMatchCol
        Debug.Print oMatch.SubMatches(0)
    
    Next oMatch

End Sub

The ATL source

Not only am I pulling the square bracket trick, using DispId(-5) I am also pulling a trick to make a class global by using appobject idl attribute. Here is the ATL source code for the class SourceFragmentLib.Src

import "oaidl.idl";
import "ocidl.idl";
import "shobjidl.idl";

[
 uuid(45e7ef27-47c2-40cd-8be7-7a943549469d),
 version(1.0),
]
library SourceFragmentLib
{
 importlib("stdole2.tlb");

 [
  odl,
  uuid(f103332b-4ba0-4c4e-b846-020bc694a85b),
  version(1.0),
  dual,
  oleautomation
 ]
 interface ISrc : IDispatch
 {
  [id(0xfffffffb)]
  HRESULT Line([in]BSTR sIn, [out, retval] BSTR* outRetVal);
 };

 [
  uuid(8d8e4c03-9397-4d07-b171-e6aa2ec61aae),
  version(1.0),
  appobject
 ]
 coclass Src
 {
  [default] interface ISrc;
 };
};

For the header file Src.h add the following line

 STDMETHOD(Line)(BSTR sIn, BSTR* outRetVal);

For the source file Src.cpp add the following implementation which simply copies the in string to the return string.

STDMETHODIMP CSrc::Line(BSTR sIn, BSTR* outRetVal)
{
 HRESULT hr = S_OK;
 CComBSTR bstrIn(sIn);

 bstrIn.CopyTo(outRetVal);
 return S_OK;
}

C# Source

Currently working on a C# source alternative to the ATL/C++ and whilst I can style the method with DispId(-5) getting a C# object to be global in VBA client code is problematic but hopefully I will post a solution soon. UPDATE, this involves launching midl after adjusting the idl source code.

VBA - Writing Dictionaries to Worksheet Cells

I love Dictionaries but I ought to post more samples as to how wonderfully versatile they are. Here is a frequently asked question about how to write contents of dictionary to a block of cells.

Option Explicit

Sub FAQDictionariesAndWorksheetCells()

    '* how to populate a dictionary and then write keys of dictionary to sheet

    Dim dic As Scripting.Dictionary     '* Tools->References: Microsoft Scripting Runtime
    Set dic = New Scripting.Dictionary
    
    dic.Add "Red", 128
    dic.Add "Blue", 224
    dic.Add "Green", 255
    
    '* as columns
    Sheet1.Cells(1, 1).Resize(dic.Count, 1).Value2 = Application.Transpose(dic.Keys)
    Sheet1.Cells(1, 2).Resize(dic.Count, 1).Value2 = Application.Transpose(dic.Items)
        
    '* as rows
    Sheet1.Cells(1, 4).Resize(1, dic.Count).Value2 = dic.Keys
    Sheet1.Cells(2, 4).Resize(1, dic.Count).Value2 = dic.Items

End Sub

Thursday 3 May 2018

VBA - COM - DispId(-5) gives VBA Square Brackets but the argument is passed as a string

So the flurry of posts around DispIds is because of a very interesting question on SO How to use square brackets for a string evaluation in VBA? . I had read in some old COM books that it is an ActiveX Control standard to allow a square bracket syntax, that it requires setting the method's DispId to -5 (hex 0xfffffffb) and that by convention the method name is usually called Evaluate.

I think it's best to start off with some code and then talk about it. We can enable the square brackets for a C# authored component, the code below is a .NET class library with ComVisible(true) is AssemblyInfo.cs and with checkbox 'Register for Interop' checked. You also need to run Visual Studio with admin rights.

using System.Collections.Generic;
using System.Runtime.InteropServices;

namespace SquareBracketsCSharp
{
    public interface IList
    {
        [DispId(-5)]
        object Foo(object idx);
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IList))]
    public class CList : IList
    {
        private List m_List = new List();

        public CList()
        {
            for (int i = 1; i < 5; i++)
            {
                m_List.Add(i * i);
            }
        }

        object IList.Foo(object idx)
        {
            int idx2;
            if (int.TryParse((string)idx, out idx2))
            {
                return m_List[idx2];
            }
            else
            {
                return 0;
            }
        }
    }

So the code above creates a short list of square numbers. The method Foo has DispId(-5) which makes it the square brackets method for that class. Note well, that the method does not have to be called Evaluate as written some places. You can change the method's name to Evaluate but it won't help.

Now let's write some client VBA code. Below the code attempts to loop through the list but it fails returning zero for each iteration. Why? Because lLoop gets passed as a string! And you can see that happening if you put a break point in the C# code. So you'll see "lLoop" instead of an integer.

Sub TestFibonacci()
    Dim oList As SquareBracketsCSharp.CList
    Set oList = New SquareBracketsCSharp.CList
    
    Dim lLoop As Long
    For lLoop = 0 To 2
        Dim lTerm As Long
        lTerm = oList.[lLoop]
        Debug.Print lTerm
    Next
End Sub

Wherefore Square Brackets

In the code given above the square brackets are useless for simulating C++/C#/Java square bracketed access to array. They will never be indexers for VBA. So, is there any value at all in this syntax then?

Well there might be use case when an argument itself has many quotation marks; in VBA quotes in strings have to be doubled up making it look a bit ugly so in the Immediate Window we type

?"""He said"",""She said"""
"He said","She said"

To illustrate how we can be liberated from the double quote we can insert the following line of code into the above VBA program...

oList.["He said","She said"]

This isn't a trivial nothing, on many occasions when writing code I have had a need to embed expressions with double quotes, often these expressions are in fact fragments of other programming languages such as SQL or JavaScript. Perhaps another post might illustrate the usefulness of being liberated from doubling double quotes.

DispID(-5) does not work for VBA source

The previous posts on DispID assume the ability to export a class from VBA, and add hidden attribute using Attribute <MethodName>.VB_UserMemId = [0|-4] where 0 denotes the default method and -4 denotes an enumeration factory. Sadly, I could not get DispId -5 to work for a VBA class. So you'll need C# (or C++ ATL) to author components with square brackets enabled.

Wednesday 2 May 2018

COM - Magic DispIds

So the Microsoft webserver for this page is really slow so I'm recreating this table on this blog post for quick reference. The original is at https://msdn.microsoft.com/en-us/library/windows/desktop/ms221242(v=vs.85).aspx .

Constant/valueDescription
DISPID_COLLECT
-8

The Collect property. You use this property if the method you are calling through Invoke is an accessor function.

DISPID_CONSTRUCTOR
-6

The C++ constructor function for the object.

DISPID_DESTRUCTOR
-7

The C++ destructor function for the object.

DISPID_EVALUATE
-5

The Evaluate method. This method is implicitly invoked when the ActiveX client encloses the arguments in square brackets. For example, the following two lines are equivalent:

x.[A1:C1].value = 10

x.Evaluate("A1:C1").value = 10

DISPID_NEWENUM
-4

The _NewEnum property. This special, restricted property is required for collection objects. It returns an enumerator object that supports IEnumVARIANT, and should have the restricted attribute specified.

DISPID_PROPERTYPUT
-3

The parameter that receives the value of an assignment in a PROPERTYPUT.

DISPID_UNKNOWN
-1

The value returned by IDispatch::GetIDsOfNames to indicate that a member or parameter name was not found.

DISPID_VALUE
0

The default member for the object. This property or method is invoked when an ActiveX client specifies the object name without a property or method.

VBA - Enumeration Methods (DispId(-4))

So magic DispIds (short for Dispatch IDs) have been on my mind today, a clutch of posts earlier about using bang syntax once you set a method dispid to zero. Here we talk about another magic number -4 which denotes an enumeration factory method that VBA will call on your object if found in a For Each .. In .. construct.

Other bloggers usually illustrate this with a canonical example about collection classes. Instead, I'll give a twist on Linq's Where filter function. We'll need a class, but first here is the client (standard) module. This module also houses the predicate SheetIsOdd used to tell if a sheet gets added to the collection or not.

Option Explicit

Sub Test()
    Dim oWhere As New Where
    
    Dim wsOdd As Variant
    For Each wsOdd In oWhere.Init(ThisWorkbook.Worksheets, "SheetIsOdd")
        Debug.Print wsOdd.Name
    Next
End Sub

Function SheetIsOdd(sh As Excel.Worksheet) As Boolean
    Dim lSuffix As Long
    If IsNumeric(Right$(sh.Name, 1)) Then
        lSuffix = Right$(sh.Name, 1)
    End If
    
    If lSuffix Mod 2 = 1 Then
        SheetIsOdd = True
    End If
End Function

Where class

The Where class has an Init method that returns an instance of itself to allow chaining methods. The NewEnum method delegates the enumeration to a VBA.Collection populated during Init. The NewEnum method cannot take parameters because it is defined as parameterless. We supply parameters via Init and use chaining methods so it appears seamless.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Where"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mcol As VBA.Collection

Private mSrcCol As Object
Private msCallbackPredicate As String

Public Function Init(ByVal col As Excel.Sheets, ByVal sCallbackPredicate As String) As Where
    Set mSrcCol = col
    msCallbackPredicate = sCallbackPredicate
    Set Init = Me '* allows chaining
End Function

Public Function NewEnum() As IEnumVARIANT
Attribute NewEnum.VB_UserMemId = -4
    'Attribute NewEnum.VB_UserMemId = -4
    
    Set mcol = New VBA.Collection
        
    Dim oLoop As Object
    For Each oLoop In mSrcCol

        If Application.Run(msCallbackPredicate, oLoop) Then
            mcol.Add oLoop
        End If
    Next
    
    Set NewEnum = mcol.[_NewEnum]
End Function

VBA - C# - Bang Syntax Part 3 - C# Interop JSON with Bang Syntax

So it's not just Script Control based JSON parsers that can benefit from the bang ! syntax, we can use C# and COM interop to export Newtonsoft's very popular .NET JSON parser for use in VBA. When defining the interop interface if we add DispId(0) then enable the bang ! operator which calls the default method to get compact syntax. Here is client VBA...

Sub Test()

    Dim sJSON As String
    sJSON = VBA.Replace("{ 'name':'John', 'age':30, 'cars':{ 'car1':'Ford','car2':'BMW','car3':'Fiat'} }", "'", """")

    Dim oCJSONParser As CJSONParser
    Set oCJSONParser = New CJSONParser
    
    Dim oRoot As CJSONToken
    Set oRoot = oCJSONParser.ParseJSONString(sJSON)

    Dim oCars As CJSONToken
    Set oCars = oRoot!cars                  '* equivalent of 'Set oCars = oItem.GetToken("cars")
    
    Dim oCar2
    oCar2 = oCars!car2                      '* equivalent of 'Set oCar2 = oCars.GetToken("car2")
    
    '* or chain syntax
    oCar2 = oRoot!cars!car2
    
    Stop
End Sub

And here is the C# code for a .NET library assembly (i.e. a DLL) with Register for Interop checkbox checked and ComVisible(true) in AssemblyInfo.cs

using Newtonsoft.Json.Linq;   //Nuget Newtonsoft.Json.11.0.2
using System.Runtime.InteropServices;


namespace Foo
{

    public interface IJSONParser
    {
        IJSONToken ParseJSONString(string sJSON);
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IJSONParser))]
    public class CJSONParser : IJSONParser
    {
        private JToken m_oJObject;

        IJSONToken IJSONParser.ParseJSONString(string sJSON)
        {
            m_oJObject = JToken.Parse(sJSON);
            CJSONToken oToken = new CJSONToken(m_oJObject);
            return oToken;
        }
    }

    public interface IJSONToken
    {
        [DispId(0)]
        object GetToken(string sKey);
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IJSONToken))]
    public class CJSONToken : IJSONToken
    {
        private JToken m_oToken;

        public CJSONToken(JToken token)
        {
            m_oToken = token;
        }

        object IJSONToken.GetToken(string sKey)
        {
            JToken oToken = m_oToken[sKey];

            if (oToken is JValue)
            {
                JValue jv = (JValue)oToken;
                return jv.Value;
            }
            else
            {
                CJSONToken token = new CJSONToken(oToken);
                return token;
            }
        }
    }
}

VBA - Bang Syntax Part2 - JSON Parsing Revisited (again!)

Plenty of JSON parsing posts on this blog and here I return again to the subject.

I was so hopefuil when I discovered the ScriptControl and its ability to return parsed JSON, one could use the dot notation to traverse the hierarchy if it weren't for VBA amending casing, see this SO question for a complete example of this pain. The answer then was to use CallByName and that still is the answer but we can use the bang ! syntax where the dots used to be using the following code.

First, let me show you the client code to whet your appetite. Q. How does this solves the casing issue? A. Because the text to the right of the bang ! is treated as a string to be passed to the default member (which I will show you how to setup shortly).

Sub Test()

    Dim oJSONParser As JSONParser
    Set oJSONParser = New JSONParser
    
    Dim sJSON As String
    sJSON = VBA.Replace("{ 'name':'John', 'age':30, 'cars':{ 'car1':'Ford','car2':'BMW','car3':'Fiat'} }", "'", """")
    
    Dim oJSONBang As JSONBang
    Set oJSONBang = oJSONParser.DecodeJsonString(sJSON)

    Dim oCars As JSONBang
    Set oCars = oJSONBang!cars  ' drill into cars property
    
    Dim sCar2 As String
    sCar2 = oCars!car2     ' drill into car2 property
    
    '* or use chain syntax
    sCar2 = oJSONBang!cars!car2
    

    Stop

End Sub

Ok so there are two classes, JSONParser and JSONBang, the former houses the parser logic whilst the latter represents each segment.

JSONParser class

So this parser class uses the Microsoft Script Control but uses a downloaded script authored by Douglas Crockford that parses JSON to an object. Please use Douglas's script and please DO NOT USE EVAL. I have also added a ToString override helper function.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "JSONParser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'* Tools->References
' MSScriptControl      Microsoft Script Control 1.0    C:\Windows\SysWOW64\msscript.ocx
' Scripting            Microsoft Scripting Runtime     C:\Windows\SysWOW64\scrrun.dll
' MSXML2               Microsoft XML, v6.0             C:\Windows\SysWOW64\msxml6.dll

Private Function SC() As ScriptControl
    Static soSC As ScriptControl
    If soSC Is Nothing Then

        Set soSC = New ScriptControl
        soSC.Language = "JScript"
        
        '* https://stackoverflow.com/questions/45015/safely-turning-a-json-string-into-an-object
        soSC.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
        soSC.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "
        soSC.AddCode "function overrideToString(jsonObj) { jsonObj.toString = function() { return JSON.stringify(this); } }"

    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

Public Function DecodeJsonString(ByVal JsonString As String) As JSONBang
    Dim oSC As ScriptControl
    Set oSC = SC

    Dim obj As Object
    Set obj = oSC.Run("JSON_parse", JsonString)

    Call oSC.Run("overrideToString", obj) '* this gives JSON rendering instead of "[object Object]"

    Set DecodeJsonString = New JSONBang
    Set DecodeJsonString.JScriptTypeInfo = obj

End Function

JSONBang class

So this JSONBang class has the Item method annotated with Attribute Item.VB_UserMemId = 0 so it becomes the default method and that way we can use bang ! because it looks for a default method with a single parameter and passes that to the right of the bang as the parameter.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "JSONBang"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mobjJScriptTypeInfo As Object

Public Property Set JScriptTypeInfo(rhs As Object)
    If TypeName(rhs) = "JScriptTypeInfo" Then
        Set mobjJScriptTypeInfo = rhs
    Else
        Err.Raise 13
    End If
End Property

Public Property Get JScriptTypeInfo() As Object
    Set JScriptTypeInfo = mobjJScriptTypeInfo
End Property

Public Function ToString() As String
    ToString = mobjJScriptTypeInfo
End Function

Public Function Item(Key)
Attribute Item.VB_UserMemId = 0
    
    'Attribute Item.VB_UserMemID = 0
    
    If mobjJScriptTypeInfo Is Nothing Then Err.Raise vbObjectError, "#base JSON class (JScriptTypeInfo) not yet!"
    
    If IsObject(CallByName(mobjJScriptTypeInfo, Key, VbGet)) Then
    
        Dim obj As Object
        Set obj = CallByName(mobjJScriptTypeInfo, Key, VbGet)
    
        Dim oRet As JSONBang
        Set oRet = New JSONBang
        Set oRet.JScriptTypeInfo = obj
        
        Set Item = oRet
    
    Else
        Dim vVar
        vVar = CallByName(mobjJScriptTypeInfo, Key, VbGet)
        Item = vVar
    End If
    

End Function

VBA - Bang Syntax Part1 - Worksheets, Dictionaries and User Classes

A flurry of ideas occurred today but I will start with the ! bang syntax. The bang (!) allows a more compact syntax of code to be written. It works by passing what follows to the default member. Some examples should clarify

Sub TestWorksheetsBang()
    
    Dim ws As Excel.Worksheet
    
    Set ws = ThisWorkbook.Worksheets!Sheet1
    'is equivalent to
    Set ws = ThisWorkbook.Worksheets.Item("Sheet1")

End Sub

Curiously, the Item method does not have DispId of 0 which is what I'd expect (it has &hAA instead). Nevertheless this works like a default member. Run the above code if you don't believe me.

Next example is using the Scripting.Dictionary from the Microsoft Scripting Runtime, the default methood is item which means we can write the following code. In this case Item does has Disp of 0.

Sub TestScriptingDictionaryBang()

    Dim oDic As Scripting.Dictionary      '* Tools->References Microsoft Scripting Runtime
    Set oDic = New Scripting.Dictionary
    
    oDic.Add "green", &H80
    oDic.Add "red", &H40
    oDic.Add "blue", &HFF
    
    Debug.Assert oDic.Count = 3
    Debug.Print oDic.Item("green")
    
    
    Debug.Print oDic("green")    '* I don't much like this
    Debug.Print oDic!green       '* for compactness I'd prefer this

End Sub

Final example in this part can we write our own classes and take advantage of bang syntax. Yes we can but we have to export the class module and annotate in a text editor the default member with Attribute Item.VB_UserMemID = 0 before re-importing. Here is a class which subclasses the Scripting.Dictionary and I have already annotated the Item method.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Dictionary2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mdic As New Scripting.Dictionary   '* Tools->References Microsoft Scripting Runtime

Public Function Add(Key, Item)
    mdic.Add Key, Item
End Function

Public Function Exists(Key)
    Exists = mdic.Exists(Key)
End Function

Public Function Keys()
    Keys = mdic.Keys
End Function

Public Function Items()
    Items = mdic.Items
End Function

Public Property Get Item(Key)
    Attribute Item.VB_UserMemID = 0
    Item = mdic.Item(Key)
End Property

Public Property Get Count() As Long
    Count = mdic.Count
End Property

Public Sub Reset()
    Set mdic = New Scripting.Dictionary
End Sub

The client code for the above class is almost identical to before. Nevertheless here it is.

Sub TestVBADictionaryBang()

    Dim oDic2 As Dictionary2
    Set oDic2 = New Dictionary2
    
    oDic2.Add "green", &H80
    oDic2.Add "red", &H40
    oDic2.Add "blue", &HFF
    
    Debug.Assert oDic2.Count = 3
    Debug.Print oDic2.Item("green")
    
    
    Debug.Print oDic2("green")
    Debug.Print oDic2!green

End Sub