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

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

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

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.

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/value	Description
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

C# - VBA - COM - For image processing ditch WinAPI/GDI and use .NET instead

So I had cause to load an image file and query the colour of a pixel, so I needed some image processing code. I had encountered some code before but did not capture it for this blog. Investigating today I was depressed by the obscure way the Windows API worked in this regard, then to find that the Windows API declaration would need to change for 64-bit versions of VBA I rebelled. Instead, I reached for the .NET image classes and chose to export them from a C# class library using .NET/COM interop. Life is much simpler now.

Below is some code that calls into the C# class library, the source for which can be found on this counterpart blog post. Together these programs allow a picture to written to Excel cells like this...

Option Explicit

Sub Test()
    
    DumpPictureToCells "N:\stackoverflowicon.png", False
    'DumpPictureToCells "N:\number.png", True
    
End Sub


Sub DumpPictureToCells(ByVal sFileName As String, ByVal bIsAlphaMask As Boolean)
    Dim oBitMap As ImageToByteArray.BitMap
    Set oBitMap = New ImageToByteArray.BitMap
    
    Dim bSU As Boolean
    bSU = Application.ScreenUpdating
    Application.ScreenUpdating = False
    
    
    Sheet1.Cells.Clear
    
 
    oBitMap.LoadImage sFileName

    Dim x As Long, y As Long
    For x = 0 To oBitMap.Width - 1
        For y = 0 To oBitMap.Height - 1
            Dim col As ImageToByteArray.Colour
            Set col = oBitMap.GetPixel(x, y)
            
            Dim rng As Excel.Range
            Set rng = Sheet1.Cells(y + 1, x + 1)
            
            If bIsAlphaMask Then
                rng.Interior.Color = RGB(256 - col.A, 256 - col.A, 256 - col.A)
            Else
                rng.Interior.Color = RGB(col.R, col.G, col.B)
            End If
        Next
    Next

    Application.ScreenUpdating = bSU
End Sub

Private Function ResizeCellsToBeSquare()
    
    Dim sngColWidth
    sngColWidth = 2.14 '* based on experimentation
    
    Dim lColLoop As Long
    For lColLoop = 1 To Sheet1.UsedRange.Columns.Count
        Dim rngCell As Excel.Range
        Set rngCell = Sheet1.Cells(1, lColLoop)
        
        rngCell.EntireColumn.ColumnWidth = sngColWidth
        
    Next

End Function

P.S. During the WinAPi investigation I came across this excellent website mvps.org

VBA - Use PivotTable and SpecialCells(xlCellTypeBlanks) to get totals rows

Twenty or so years ago when I learnt Excel VBA I read a book called Excel VBA Step-by-step, it was full of instructive examples as you can imagine. One example stuck with me, it used a pivottable to take some rows, do the totalling and finally format the totals back into normalised rows by pulling a trick using Excel.Range's method SpecialCells(xlCellTypeBlanks)

It remains the only use case for SpecialCells(xlCellTypeBlanks) I have encountered.

Option Explicit

Sub Test()
    Test_FillInPivotBlanks_InitialiseSheet_RunOnce
    Test_FillInPivotBlanks_CreatePivot_RunOnce
    Test_FillInPivotBlanks
End Sub

Private Function WorkingSheet() As Excel.Worksheet
    Set WorkingSheet = Sheet1 '* add as required
End Function

Sub Test_FillInPivotBlanks_InitialiseSheet_RunOnce()

    Dim sh As Excel.Worksheet
    Set sh = WorkingSheet
    sh.Cells.Clear
    
    Dim vSeed As Variant
    vSeed = [{"Colour","Shape","Number";"Red","Triangle",2;"Red","Triangle",22;"Red","Square",3;"Red","Circle",8;"Green","Square",13;"Blue","Circle",21}]
    
    sh.Range("a1:c7").Value2 = vSeed
End Sub

Sub Test_FillInPivotBlanks_CreatePivot_RunOnce()

    Dim sh As Excel.Worksheet
    Set sh = WorkingSheet

    Dim rng As Excel.Range
    Set rng = sh.Range("a1").CurrentRegion
    rng.Select
    
    Dim rngDest As Excel.Range
    Set rngDest = sh.Range("f1")
    rngDest.CurrentRegion.Delete
    
    Dim pvtCache As Excel.PivotCache
    Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rng.Address, Version:=xlPivotTableVersion10)
        
    Dim pvtTable As Excel.PivotTable
    Set pvtTable = pvtCache.CreatePivotTable( _
        TableDestination:=sh.Name & "!R1C6", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion10)
    
    pvtTable.ColumnGrand = False
    pvtTable.RowGrand = False
    
    Dim pvtfldCol As Excel.PivotField
    Set pvtfldCol = pvtTable.PivotFields("Colour")
    pvtfldCol.Orientation = xlRowField
    pvtfldCol.Position = 1

    With pvtTable.PivotFields("Shape")
        .Orientation = xlRowField
        .Position = 2
        
    End With
    pvtTable.AddDataField pvtTable.PivotFields("Number"), "Sum of Number", xlSum
    
    pvtTable.PivotFields("Colour").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    

End Sub

Sub Test_FillInPivotBlanks()

    Dim sh As Excel.Worksheet
    Set sh = WorkingSheet

    Dim rngDest As Excel.Range
    Set rngDest = sh.Range("f1").CurrentRegion
    
    rngDest.Copy
    sh.Range("J1").PasteSpecial xlPasteValues

    Application.CutCopyMode = False

    Dim rngCopied As Excel.Range
    Set rngCopied = sh.Range("J1").CurrentRegion

    Dim rngBlanks As Excel.Range
    Set rngBlanks = rngCopied.SpecialCells(xlCellTypeBlanks)
    
    Dim rngBlankLoop As Excel.Range
    For Each rngBlankLoop In rngBlanks
        Debug.Assert IsEmpty(rngBlankLoop)
        rngBlankLoop.FormulaR1C1 = "=R[-1]C"
    Next rngBlankLoop

End Sub

COM - Windows - WOW32_64 - Isolate legacy 32-bit component from 64-bit clients by using a surrogate process

On StackOverflow, the problem of 64bit vs 32bit for VBA programming arises quite often on SO. I can't claim this will be a definitive blog post but here I gather some thoughts and links that I believe would lead to generic solution.

Firstly, Microsoft has not left 32-bit components completely hanging. It does have an inter-operability technology for this, its called Windows on Windows (WOW), this was invented for the 16bit vs 32bit years ago. WOW also exists for the 32-bit vs 64-bit, it sometimes called Wow64_32 to distinguish from previous generation.

You would have thought Wow64_32 would be enough for 32-bit components to be inter-operable in-process for 64 bit clients. Unfortunately one cannot load win32 modules into a win64 process space. Instead one must use a surrogate as outlined in this article Registering the DLL Server for Surrogate Activation. Using a surrogate process means one can keep 32-bit components separate from 64-bit clients.

Links

• Registering the DLL Server for Surrogate Activation
• Wikipedia - Windows on Windows
• 32-bit and 64-bit Application Data in the Registry
• 64-bit client call to 32-bit COM/ATL server EXE fails
• Accessing 32-bit DLLs from 64-bit code
• SO - Out-of-Proc-COM-Server (x86): dllhost.exe looks in wrong registry path
• SO - ActiveX component can't create object when creating Lotus.NotesSession in VBA 64-bits
• Technet - Install COM Components (to COM+)
• Technet - Component Services