.NET Framework objects in VBA

So from time to time I see a snippet of code which clearly shows a .NET Framework class being instantiated and its methods called on from VBA. At some point I will investigate just how widespread this technique can be used, in the meantime I am going to on this page collect code snippets.

ArrayList

The ArrayList is a useful collections object which could replace Scripting.Dictionary. Here is some code...

Sub TestDotNetArrayList()
    
    Dim oArrayList As Object
    Set oArrayList = CreateObject("System.Collections.ArrayList")
    oArrayList.add "c"
    oArrayList.add "a"
    oArrayList.add "b"
    Debug.Assert oArrayList.Item(0) = "c"
    Debug.Assert oArrayList.Item(1) = "a"
    Debug.Assert oArrayList.Item(2) = "b"
    
    oArrayList.Sort

    '* now sorted
    Debug.Assert oArrayList.Item(0) = "a"
    Debug.Assert oArrayList.Item(1) = "b"
    Debug.Assert oArrayList.Item(2) = "c"

End Sub

StringBuilder

The StringBuilder has a VBA equivalent of Mid$ but if you really want the .NET class then below is some code. Note Intellisense is not available and you'll have to research the method overload.

Sub TestDotNetStringBuilder()

    Dim oSB As Object
    Set oSB = CreateObject("System.Text.StringBuilder")
    
    oSB.AppendFormat_5 Nothing, "hello {0}", Array("simon")
    Debug.Assert oSB.tostring = "hello simon"
    
End Sub

SortedList

There is also a SortedList which takes key value pairs but which can be difficult to access. Here I use one to sort an ordinary Scripting.Dictionary

Sub TestSortDictionary()

    Dim dicIn As Scripting.Dictionary
    Set dicIn = New Scripting.Dictionary
    
    dicIn.Add "foo", 12
    dicIn.Add "bar", 11

    Debug.Assert dicIn.Keys()(0) = "foo"
    Debug.Assert dicIn.Keys()(1) = "bar"

    Set dicIn = SortDictionary(dicIn)
    
    Debug.Assert dicIn.Keys()(0) = "bar"
    Debug.Assert dicIn.Keys()(1) = "foo"
    

End Sub

Function SortDictionary(ByVal dicIn As Scripting.Dictionary) As Scripting.Dictionary

    Dim dicSorted As Scripting.Dictionary
    Set dicSorted = New Scripting.Dictionary
    
    Dim objSortedList As Object ' mscorlib.SortedList
    Set objSortedList = CreateObject("System.Collections.SortedList") 'New mscorlib.SortedList
    
    
    Dim vKeyLoop As Variant
    For Each vKeyLoop In dicIn.Keys
        objSortedList.Add vKeyLoop, dicIn(vKeyLoop)
    
    Next
    
    Dim lKeyLoop As Long
    For lKeyLoop = 0 To dicIn.Count - 1
        
        Dim vKey As Variant
        vKey = objSortedList.GetKeyList()(lKeyLoop)
        
        dicSorted.Add vKey, dicIn(vKey)
    
    Next lKeyLoop
    
    Set SortDictionary = dicSorted
End Function

TODO: some sample code for System.Security.Cryptography.HMACSHA256

To be honest given the naming convention of .NET library where everything starts with System. then one can peruse the registry from others.

Links

• VBA voor smarties SortedList

VBA - Fast Serialization of Cells to Array Literal String

Today on StackOverflow I saw a great answer which utilizes Mid$() as a left hand operator to write into a string buffer. Concatenating strings is always slow and this is why languages such as C# and Java have a StringBuilder class. Using Mid$() on the left hand side of an assignment is VBA's equivalent of StringBuilder.

We can use this Mid$ (StringBuilder) to very quickly serialize a block of cells to an array literal which can be used to save fragments to file or for marshalling across to a web service

As a reminder array literal strings can be passed to Application.Evaluate and so parsed into an array ready to be pasted to cells. They are quite a simple format, the columns are comma separated and the rows semi-colon sepated, strings are quoted and the whole block is wrapped into curly brackets thus ...

Sub IllustratingApplicationEvaluateAndLiterals()
    
    Dim v As Variant
    v = Application.Evaluate("{""a"",""b"",3;""d"",5.1,""f""}")
    
    Debug.Assert v(1, 1) = "a"
    Debug.Assert v(1, 2) = "b"
    Debug.Assert v(1, 3) = 3
    Debug.Assert v(2, 1) = "d"
    Debug.Assert v(2, 2) = 5.1
    Debug.Assert v(2, 3) = "f"
    
End Sub

So now some code to take cells and serialize into an array literal string

Function GetRangeLiteral(ByVal rngSource As Excel.Range)
    Const CELL_LENGTH = 257 'Add 2 for double quotes
    
    With rngSource
        Dim lRows As Long
        lRows = .Rows.Count
        
        Dim lColumns As Long
        lColumns = .Columns.Count
        
        Dim lBufferSize As Long
        lBufferSize = CELL_LENGTH * .Cells.Count + lRows + (lRows * lColumns)
    End With
    
    '* initialise the buffer with spaces then start opening brace
    Dim sText As String
    sText = VBA.Space(lBufferSize)
    Mid$(sText, 1, 1) = "{"
    
    Dim lCursor As Long
    lCursor = 1
    
    Dim vData()
    vData = rngSource.Value

    Dim lRow As Long
    For lRow = 1 To lRows
    
        '* if past first row then we need a row continuation
        If lRow > 1 Then
            lCursor = lCursor + 1
            Mid$(sText, lCursor, 1) = ";"
        End If

        Dim lColumn As Long
        For lColumn = 1 To lColumns
            
            Dim vCell As Variant
            vCell = vData(lRow, lColumn)
            
            Dim lCellLength As Long
            lCellLength = Len(vCell)
            
            '* extend buffer if necessary
            If lCursor + lCellLength + 2 > Len(sText) Then sText = sText & Space(CDbl(lBufferSize / 4))
            
            '* if past first column then we need a cell continuation
            If lColumn > 1 Then
                lCursor = lCursor + 1
                Mid(sText, lCursor, 1) = ","
            End If

    
            '* write in value directly into buffer, wrap quotes around strings
            If (VBA.TypeName(vCell) = "String") Then
                lCellLength = lCellLength + 2
                Mid$(sText, lCursor + 1, lCellLength) = """" & vCell & """"
            Else
                Mid$(sText, lCursor + 1, lCellLength) = vCell
            End If
            
            '* increment cursor
            lCursor = lCursor + lCellLength
        Next
    Next

    GetRangeLiteral = Left$(sText, lCursor) & "}"
End Function

Function TestGetRangeLiteral()
    
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Worksheets.Item(4).Range("c3:e4")
    rng.Cells(1, 1) = "a"
    rng.Cells(1, 2) = "b"
    rng.Cells(1, 3) = 3
    rng.Cells(2, 1) = "d"
    rng.Cells(2, 2) = 5.1
    rng.Cells(2, 3) = "f"
    
    Dim sRange As String
    sRange = GetRangeLiteral(rng)
    
    Debug.Assert sRange = "{""a"",""b"",3;""d"",5.1,""f""}"
    
    Dim v As Variant
    v = Application.Evaluate(sRange)
    Debug.Assert v(1, 1) = "a"
    Debug.Assert v(1, 2) = "b"
    Debug.Assert v(1, 3) = 3
    Debug.Assert v(2, 1) = "d"
    Debug.Assert v(2, 2) = 5.1
    Debug.Assert v(2, 3) = "f"
    
End Function