Part and Parse()-l

Today, I'm excited to write about one of my favorite functions and a key building block to some of the most advanced features I've implemented in Microsoft Access.  The function is named Parse(), and it extracts values from a key-value string.

Parsing connection strings

What do I mean by a "key-value string"?  The easiest way to explain it is with an example.  Here is a typical connect string for a DSN-less connection to a table in SQL Server:

Const CnString As String = "ODBC;DRIVER=SQL Server;SERVER=MyDbServer;" & _ 
    "Trusted_Connection=Yes;APP=Microsoft Office;DATABASE=MyDatabase;"

I first wrote this function to solve the simple problem of extracting values from SQL Server connection strings.  Let's say I wanted to extract the value of the Server key.  This is subtly difficult, as there are three separate instances of the text "Server" within the above string.  

Here's how I would use my Parse() function to extract the Server value:

Debug.Print Parse(CnString, "Server")
MyDbServer

When you call the function, you pass it an assignment character and delimiter.  By default, these are = and ;, respectively.  

A third optional argument is the return type.  The function itself always returns a Variant, but if you request the variant be of a specific type, then the function will coerce the result into that type.  This serves three purposes: 1) avoid Nulls, 2) avoid "Data type mismatch" errors at runtime, and 3) convey semantic meaning about what sort of value you expect to be stored along with that key in the source string.

The Tag property

The Tag property is a string property attached to every form, report, and control in Microsoft Access.  It is the Swiss Army knife of your Access tool box.  You can save any string you want in that property and use it for...anything.  

I like to use it for things like hiding or locking a group of controls at runtime.  At design time, you set the Tag property for a subset of controls. Then, on the Form_Current() event, you loop through each control in the form/report/section, and change some other property of the control based on what is (or is not) saved in the Tag property.

As you start using the Tag property and realize how wonderful it is, eventually you will reach a point where you want to attach two different pieces of data to a single control.  Unfortunately, you can't add extra Tag properties; you just get the one.  The solution? Concatenate as many properties as you need into a single string and assign that to the Tag property.  Then, extract the individual values from the string using the Parse() function.

For example, I wrote a resizing class module that allows for fine-grained control over resizing of form controls.  Imagine a form with four subforms arranged in a 2x2 grid pattern.  We want the subforms to grow evenly in the horizontal direction, but vertically we want the lower subforms to grow three times faster than the upper subforms.  I would set the Tag property for the lower right subform to this:

HSlide=.5;HGrow=.5;VSlide=.25;VGrow=.75

In my resizing class module, I parse each control when the form is opened to determine how each control will need to be moved, grown, or shrunk in relation to the resizing of the form itself.  Here's what that looks like:

CtlProps(htGrow) = Parse(Ctl.Tag, "HGrow")
CtlProps(htSlide) = Parse(Ctl.Tag, "HSlide")
CtlProps(vtGrow) = Parse(Ctl.Tag, "VGrow")
CtlProps(vtSlide) = Parse(Ctl.Tag, "VSlide")

The OpenArgs argument

The DoCmd.OpenForm and DoCmd.OpenReport routines each have an optional OpenArgs argument.  That argument serves the same purpose as the Tag property; it exists as a catch-all for whatever you might want or need.  

Let's say we have a report that the user has filtered based on some criteria.  We're building the WHERE clause using SQL syntax, but we also want to display a human-readable version of that WHERE clause in the page header of the report.  Here's how we might call that report, using another of my favorite string functions, Conc():

Dim RptInfo As String

RptInfo = Conc(RptInfo, "DisplayFilter=Accounts Added This Year\nRegion = South", ";")
RptInfo = Conc(RptInfo, "ShadeAlternateRows=" & Me.chkShadeRows, ";")
RptInfo = Conc(RptInfo, "FormatForDuplex=" & Me.chkDuplex, ";")

Docmd.OpenReport "MyReport", acViewPreview, , Criteria, , RptInfo

Then, in the Report_Open() event, we could extract this information back out using the Parse() function:

Dim DisplayFilter As String
DisplayFilter = Parse(Me.OpenArgs, "DisplayFilter", vbString)

Dim ShadeRows As Boolean
ShadeRows = Parse(Me.OpenArgs, "ShadeAlternateRows", vbBoolean)

Dim FormatForDuplex As Boolean
FormatForDuplex = Parse(Me.OpenArgs, "FormatForDuplex", vbBoolean)

The alternative to using OpenArgs for passing this sort of information to a report (or form), is often to use some sort of global state.  That is, a global variable, the TempVars collection, or even the form where you collected this information itself.  However, once you start relying on global state, it becomes way too easy to introduce subtle and hard-to-find bugs into your program.  Anything we can do to avoid that is a good thing.

Disadvantage

One big disadvantage to this approach is that it lacks compile-time checking.  If I misspell one of the strings or use slightly different key names for setting the values versus retrieving them, then I'll end up with a bug that could easily go missed. The best way to avoid that is by using constants for the key strings.  Of course, those constants would need to be in the global namespace, which is not ideal either.

Regardless of how you decide to mitigate the issue, it is important that you at least be aware of it.

The code: Parse()

'---------------------------------------------------------------------------------------
' Procedure : Parse
' DateTime  : 7/16/2009 - 4/30/2015 17:41
' Author    : Mike Wolfe <mike@nolongerset.com>
' Purpose   : Parse a string of keys and values (such as a connection string) and return
'               the value of a specific key.
' Usage     - Use to pass multiple arguments to forms via OpenArgs
'           - Keep multiple arguments in the Tag property of forms and controls.
'           - Use to parse a user-entered search string.
' Notes     - Defaults to using connection string formatted key-value pairs.
'           - Specifying a ReturnType guarantees the type of the result and allows the
'               function to be safely called in certain situations.
'  7/23/09  : Modified to allow the use of a literal space as a delimiter while allowing
'               values to have spaces as well. For example:
'>>> Parse("Name : Abraham Lincoln Address : 1600 Pennsylvania Ave NW Zip : 20500","Address",12,":"," ")
' 1600 Pennsylvania Ave NW
'  7/23/09  : Passing an empty key returns the start of the string until the first
'               key is found.  For example:
'>>> Parse("Abraham Lincoln Address : 1600 Pennsylvania Ave NW Zip : 20500","",12,":"," ")
' Abraham Lincoln
'>>> Parse("BlueReqd=True; RedReqd=True; Reqd=False; GreenReqd=True", "Reqd", 11)
' False
'  4/30/15  : Allow for assignment characters to be used within a value; for example:
'>>> Parse("Caption=Test;IsIn=SELECT ID FROM MyTable WHERE FKey=1;Foo=Bar", "IsIn")
' SELECT ID FROM MyTable WHERE FKey=1
'---------------------------------------------------------------------------------------
'
Function Parse(Txt As Variant, Key As String, _
               Optional ReturnType As VbVarType = vbVariant, _
               Optional AssignChar As String = "=", _
               Optional Delimiter As String = ";") As Variant
    Dim EndPos As Integer, Result As Variant
    Result = Null
    If IsNull(Txt) Then
        Parse = Null
    ElseIf Len(Key) = 0 Then
        EndPos = InStr(Txt, AssignChar)
        If EndPos = 0 Then
            Result = Trim(Txt)
        Else
            If InStrRev(Txt, " ", EndPos) = EndPos - 1 Then
                EndPos = InStrRev(Txt, Delimiter, EndPos - 2)
            Else
                EndPos = InStrRev(Txt, Delimiter, EndPos)
            End If
            Result = Trim(Left(Txt, EndPos))
        End If
    Else
        Dim KeyStartPos As Integer, ValStartPos As Integer
        KeyStartPos = InStr(Txt, Key & AssignChar)
        'Allow for space between Key and Assignment Character
        If KeyStartPos = 0 Then
            KeyStartPos = InStr(Txt, Key & " " & AssignChar)
            If KeyStartPos > 0 Then ValStartPos = KeyStartPos + Len(Key & " " & AssignChar)
        Else
            ValStartPos = KeyStartPos + Len(Key & AssignChar)
        End If
        If ValStartPos = 0 Then
            Parse = Null
        Else
            'Check prior characters to ensure we are not looking at a substring of another key
            Dim i As Long
            For i = KeyStartPos - 1 To 1 Step -1
                Dim ThisChar As String
                ThisChar = Mid(Txt, i, 1)
                Select Case ThisChar
                Case Delimiter
                    'we're at the delimiter, no need for further checking
                    Exit For
                    'note that the order of Case statements is important; we need to check
                    '   for the delimiter first in case space or tab are being used as delimiters
                Case " ", vbTab
                    'ignore whitespace
                Case Else
                    'it appears this is a substring of another key, so we'll make a recursive
                    '   call to this function starting with the character beyond the StartPos:
                    Parse = Parse(Mid(Txt, KeyStartPos + 1), Key, ReturnType, AssignChar, Delimiter)
                    Exit Function
                End Select
            Next i
            
            'Allow for assignment characters to be used within a value
            Dim NextDelimPos As Long
            NextDelimPos = InStr(ValStartPos, Txt, Delimiter)
            Dim BeginEndPosSearch As Long
            BeginEndPosSearch = ValStartPos
            Do
                EndPos = InStr(BeginEndPosSearch, Txt, AssignChar)
                BeginEndPosSearch = EndPos + 1
            Loop Until EndPos > NextDelimPos Or EndPos = 0
            '----------------------------------------------------------
            
            If EndPos = 0 Then
                If Right(Txt, Len(Delimiter)) = Delimiter Then
                    Result = Trim(Mid(Txt, ValStartPos, _
                                      Len(Txt) - Len(Delimiter) - ValStartPos + 1))
                Else
                    Result = Trim(Mid(Txt, ValStartPos))
                End If
            Else
                If InStrRev(Txt, Delimiter, EndPos) = EndPos - 1 Then
                    EndPos = InStrRev(Txt, Delimiter, EndPos - 2)
                Else
                    EndPos = InStrRev(Txt, Delimiter, EndPos)
                End If
                If EndPos < ValStartPos Then
                    Result = Trim(Mid(Txt, ValStartPos))
                Else
                    Result = Trim(Mid(Txt, ValStartPos, EndPos - ValStartPos))
                End If
            End If

        End If
    End If
    Select Case ReturnType
    Case vbBoolean
        If IsNull(Result) Or Len(Result) = 0 Or Result = "False" Then
            Parse = False
        Else
            Parse = True
            If IsNumeric(Result) Then
                If Val(Result) = 0 Then Parse = False
            End If
        End If

    Case vbCurrency, vbDecimal, vbDouble, vbInteger, vbLong, vbSingle
        If IsNumeric(Result) Then
            Select Case ReturnType
            Case vbCurrency: Parse = CCur(Result)
            Case vbDecimal: Parse = CDec(Result)
            Case vbDouble: Parse = CDbl(Result)
            Case vbInteger: Parse = CInt(Result)
            Case vbLong: Parse = CLng(Result)
            Case vbSingle: Parse = CSng(Result)
            End Select
        Else
            Select Case ReturnType
            Case vbCurrency: Parse = CCur(0)
            Case vbDecimal: Parse = CDec(0)
            Case vbDouble: Parse = CDbl(0)
            Case vbInteger: Parse = CInt(0)
            Case vbLong: Parse = CLng(0)
            Case vbSingle: Parse = CSng(0)
            End Select
        End If

    Case vbDate
        If IsDate(Result) Then
            Parse = CDate(Result)
        ElseIf IsNull(Result) Then
            Parse = 0
        ElseIf IsDate(Replace(Result, "#", "")) Then
            Parse = CDate(Replace(Result, "#", ""))
        Else
            Parse = 0
        End If

    Case vbString
        Parse = Nz(Result, vbNullString)

    Case Else
        If IsNull(Txt) Then
            Parse = Null
        ElseIf Result = "True" Then
            Parse = True
        ElseIf Result = "False" Then
            Parse = False
        ElseIf IsNumeric(Result) Then
            Parse = Val(Result)
        Else
            Parse = Result
        End If
    End Select
End Function

Image by MichaelGaida from Pixabay