Access JumpStart 2.0 | Blog

A Rapid Development Framework for Microsoft Access

The next refactoring to look at is “Extract Method” located here in the VBA IDE RubberDuck menu:

I’m going to look at this code and attempt to use this on OldMatches to extract the line to a new function to make it easier to read. Here is the code I am going to refactor, and I’m going to first just try a one line refactor:

Private Function InputMatchesResult(FieldName As String, dctInputs As Scripting.Dictionary, dctResults As Scripting.Dictionary) As Boolean
    Dim retVal As Boolean
    Dim OldMatches As Boolean, NewMatches As Boolean
    OldMatches = (Nz(dctResults(FieldName).OldValue, "ValueIsNull") = Nz(dctInputs(FieldName)(0), "ValueIsNull"))
    NewMatches = (Nz(dctResults(FieldName).NewValue, "ValueIsNull") = Nz(dctInputs(FieldName)(1), "ValueIsNull"))
    retVal = OldMatches And NewMatches
    InputMatchesResult = retVal
End Function

I highlight the line:
OldMatches = (Nz(dctResults(FieldName).OldValue, “ValueIsNull”) = Nz(dctInputs(FieldName)(0), “ValueIsNull”))
And then select the extract method menu item shown at the beginning of the post. Here is the resulting dialog I get:

So, I’m going to change the name to GetOldMatches and then choose the variable OldMatches as the return value of the new function. Then the dialog looks like this:

I’m not sure I want the extra NewMatches As Boolean line in the new function because I’m not using it. I suppose it’s picking that up because I’m declaring those variables on the same line.

Here is the way it refactors based on my selected options:

Private Function InputMatchesResult(FieldName As String, dctInputs As Scripting.Dictionary, dctResults As Scripting.Dictionary) As Boolean
    Dim retVal As Boolean
    Dim OldMatches As Boolean, NewMatches As Boolean
    
    OldMatches = GetOldMatches(FieldName, dctInputs, dctResults)

    NewMatches = (Nz(dctResults(FieldName).NewValue, "ValueIsNull") = Nz(dctInputs(FieldName)(1), "ValueIsNull"))
    retVal = OldMatches And NewMatches
    InputMatchesResult = retVal
End Function

Private Function GetOldMatches(ByRef FieldName As String, ByRef dctInputs As Scripting.Dictionary, ByRef dctResults As Scripting.Dictionary) As Boolean
    Dim OldMatches As Boolean, NewMatches As Boolean
    OldMatches = (Nz(dctResults(FieldName).OldValue, "ValueIsNull") = Nz(dctInputs(FieldName)(0), "ValueIsNull"))

    GetOldMatches = OldMatches
End Function

I had already refactored these methods down pretty far, so I’m not seeing too much benefit, although I like the function. Let’s try something else. I’m going to look at my library and try to find a good library function to use Extract Method.

How about this function? Let’s see if we can find a method to extract here:

' ----------------------------------------------------------------
' Procedure Name: SplitStrings
' Purpose: Splits a string into an array by checking for quoted string
'          values. Separator characters in quoted strings are ignored.
'          Can be used with Excel CSVs that are quoted.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter strInput (String): input to be parsed
' Parameter strSep: Optional Separator character. Default=","
' Return Type: Variant
' Author: jon
' Date: 10/2/2019
' ----------------------------------------------------------------
Public Function SplitStrings(strInput As String, Optional strSep As String = ",") As Variant
   Dim sep As String
   Dim QUOTED As String: QUOTED = """"
   Dim I As Integer, output As Variant, isQuotedField As Boolean
   sep = strSep
   output = Array("")
   For I = 1 To Len(strInput)
      Select Case Mid(strInput, I, 1)
         Case sep:
            If Not isQuotedField Then
               'Start up the next field
               ReDim Preserve output(UBound(output) + 1)
               output(UBound(output)) = ""
            Else
               'Quoted field so the comma is field data, not a separator
               output(UBound(output)) = output(UBound(output)) & Mid(strInput, I, 1)
            End If
         Case QUOTED:
            If isQuotedField Then
               'This is either an escaped quote or an end quote so we will have to test the next field to find out
               If I < Len(strInput) Then ' If we are on the last character and this is then an end quote, we would do nothing, otherwise we want to check the next character
                  If Mid(strInput, I + 1, 1) = QUOTED Then
                     ' This is an escaped quote
                     output(UBound(output)) = output(UBound(output)) & Mid(strInput, I, 1)
                     I = I + 1 ' Skip to the next character
                  ElseIf Mid(strInput, I + 1, 1) = sep Then
                     ' This is the end of the quoted field
                     isQuotedField = False
                  End If
               End If
            Else
               'We must also check here for a single quote with no element
               If I = Len(strInput) Then
                  output(UBound(output)) = output(UBound(output)) & Mid(strInput, I, 1)
               End If
               isQuotedField = True
            End If
         Case Else
            output(UBound(output)) = output(UBound(output)) & Mid(strInput, I, 1)
      End Select
   Next I
   SplitStrings = output
End Function

I see a case statement in there. Let’s see what happens if I extract the code in the case of “Case sep”.

Here are the options I’m selecting in the dialog:

And here is the resulting code:

' ----------------------------------------------------------------
' Procedure Name: SplitStrings
' Purpose: Splits a string into an array by checking for quoted string
'          values. Separator characters in quoted strings are ignored.
'          Can be used with Excel CSVs that are quoted.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter strInput (String): input to be parsed
' Parameter strSep: Optional Separator character. Default=","
' Return Type: Variant
' Author: jon
' Date: 10/2/2019
' ----------------------------------------------------------------
Public Function SplitStrings(strInput As String, Optional strSep As String = ",") As Variant
   Dim sep As String
   Dim QUOTED As String: QUOTED = """"
   Dim I As Integer, output As Variant, isQuotedField As Boolean
   sep = strSep
   output = Array("")
   For I = 1 To Len(strInput)
      Select Case Mid(strInput, I, 1)
         Case sep:
            
            ExecSepCase strInput, I, output, isQuotedField

         Case QUOTED:
            If isQuotedField Then
               'This is either an escaped quote or an end quote so we will have to test the next field to find out
               If I < Len(strInput) Then ' If we are on the last character and this is then an end quote, we would do nothing, otherwise we want to check the next character
                  If Mid(strInput, I + 1, 1) = QUOTED Then
                     ' This is an escaped quote
                     output(UBound(output)) = output(UBound(output)) & Mid(strInput, I, 1)
                     I = I + 1 ' Skip to the next character
                  ElseIf Mid(strInput, I + 1, 1) = sep Then
                     ' This is the end of the quoted field
                     isQuotedField = False
                  End If
               End If
            Else
               'We must also check here for a single quote with no element
               If I = Len(strInput) Then
                  output(UBound(output)) = output(UBound(output)) & Mid(strInput, I, 1)
               End If
               isQuotedField = True
            End If
         Case Else
            output(UBound(output)) = output(UBound(output)) & Mid(strInput, I, 1)
      End Select
   Next I
   SplitStrings = output
End Function

Private Sub ExecSepCase(ByRef strInput As String, ByRef I As Integer, ByRef output As Variant, ByRef isQuotedField As Boolean)
    If Not isQuotedField Then
        'Start up the next field
        ReDim Preserve output(UBound(output) + 1)
        output(UBound(output)) = ""
    Else
        'Quoted field so the comma is field data, not a separator
        output(UBound(output)) = output(UBound(output)) & Mid(strInput, I, 1)
    End If
End Sub

I’m not sure this really did much for the code readability in this case, but I see potential here. In this case, the subroutine is simply passed the working variables of the parent function as parameters by reference, so the subroutine acts on the actual parent variables. It works as I anticipate without modification. This simplifies the parent function, although the name I chose for the extracted subroutine isn’t really very descriptive. I should have chosen something better like:

BeginNextElement

Then for the case QUOTED I could extract that as a method and call it:

ProcessQuoteCharacterElement

And for Case Else I could extract that as a method and call it:

ProcessOtherElementCharacter

This would make the top level function quite easy to understand and allow the user to descend into the lower levels of the routine if they wanted to examine it.