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
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.
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.
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.
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.]
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.
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 SubAs 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!
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
https://www.speedshop.co/2017/07/11/is-ruby-too-slow-for-web-scale.html
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
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 SubSo 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 SubLet 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 SubNot 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;
}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.
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 SubSo 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 SubIn 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.
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.
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/value | Description |
|---|---|
|
The Collect property. You use this property if the method you are calling through Invoke is an accessor function. |
|
The C++ constructor function for the object. |
|
The C++ destructor function for the object. |
|
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 |
|
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. |
|
The parameter that receives the value of an assignment in a PROPERTYPUT. |
|
The value returned by IDispatch::GetIDsOfNames to indicate that a member or parameter name was not found. |
|
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. |
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 FunctionThe 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 FunctionSo 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 SubAnd 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;
}
}
}
}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 SubOk so there are two classes, JSONParser and JSONBang, the former houses the parser logic whilst the latter represents each segment.
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 FunctionSo 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 FunctionA 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 SubCuriously, 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 SubFinal 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