Following-up on this post, I wanted to be able to put a copy of that Excel workbook on a USB key and take it home to keep working on the code a bit (there's more than just one or two tables to maintain, so I'll have about a dozen forms when I'm done)... but to be able to test every functionality of my CRUD app without actually hitting the database, I had to get the abstraction level much higher than the typical vba "macro". Guess what abstraction first came to my mind.
(comments added for reviewers' convenience, they're not in the actual code)
IRepository class module
Option Explicit
Public Function GetById(ByVal id As Long) As SqlResultRow
'because, all my tables have an Id primary key.
End Function
Public Function GetAll() As SqlResult
End Function
Public Function Count() As Long
End Function
Public Sub Add(ByVal value As SqlResultRow)
End Sub
Public Sub Remove(ByVal id As Long)
End Sub
Public Sub Update(ByVal id As Long, ByVal value As SqlResultRow)
End Sub
Public Function NewItem(ByVal model As SqlResult, ByVal values As Dictionary) As SqlResultRow
'creates a new item, out of a Scripting.Dictionary containing field names & values.
'model: contains the field names.
'values: field names as key, field values for values.
End Function
Before going directly into an implementation of that interface, you need to know a little bit about the classes involved here, if you haven't seen this post (Materializing any ADODB Query) and this post (Creating ADODB Parameters on the fly), they're the foundation that led to this.
About SqlResult & SqlResultRow
All QuickXxxxx methods in the SqlCommand class iterate and consume the ADODB recordset, and take care of opening/closing the connections and the recordset. Because the results have already been iterated when the method returns, the data ends up iterated twice - once in SqlCommand (iterating the recordset), and once in the client code (iterating the DTO's). It's a tradeoff for abstraction and readability, and works very well with smaller datasets. For larger results the class exposes an equivalent API that lets the client deal with the connection, and returns an ADODB.Recordset.
SqlResultRow
The SqlResultRow class is essentially a generic DTO that allows accessing its values by index or by name, like this:
Dim description As String description = row("description")
The value obtained keeps its type, so if the database has Description (the indexer Item default property is not not case-sensitive) as a VARCHAR(50), then TypeName(row("description")) returns String.
SqlResult
This class encapsulates a List (code here) of SqlResultRow objects, and knows about the column names. Its NewEnum member has a special attribute that makes the type work with a For Each loop, so client code can do this:
sql = "SELECT Foo, DateInserted FROM FooBar WHERE DateInserted > ?;" Set result = cmd.QuickExecute(sql, Now - 30) For Each row In result Debug.Print row.ToString ' prints a CSV list of the row's values Next
The delimiter used by ToString is configurable: setting result.ValueSeparator = "|" before entering the loop will cause all rows to use | as a delimiter. If it's not specified, it defaults to a comma.
Enough talk context, here's an implementation:
CustomerGroupRepository class module
Option Explicit
Private cmd As New SqlCommand
Implements IRepository
Public Function NewItem(ByVal model As SqlResult, ByVal values As Dictionary) As SqlResultRow
Dim result As New SqlResultRow
Dim items() As String
ReDim items(LBound(values.items) To UBound(values.items))
Dim i As Integer
For i = LBound(values.items) To UBound(values.items)
items(i) = values.items(i)
Next
Set NewItem = result.Mock(model, items)
End Function
Public Sub Add(ByVal value As SqlResultRow)
Dim sql As String
sql = "INSERT INTO Planning.CustomerGroups (Description, DateInserted) VALUES (?, ?);"
cmd.QuickExecuteNonQuery sql, value("description"), Now
End Sub
Public Function GetAll() As SqlResult
Dim sql As String
sql = "SELECT Id, Description FROM Planning.CustomerGroups ORDER BY Id;"
Set GetAll = cmd.QuickExecute(sql)
End Function
Public Function GetById(ByVal id As Long) As SqlResultRow
Dim sql As String
sql = "SELECT Id, Description FROM Planning.CustomerGroups WHERE Id = ?;"
Set GetById = cmd.QuickSelectFirstRow(sql, id)
End Function
Public Sub Remove(ByVal id As Long)
Dim sql As String
sql = "DELETE FROM Planning.CustomerGroups WHERE Id = ?;"
cmd.QuickExecuteNonQuery sql, id
End Sub
Public Sub Update(ByVal id As Long, ByVal value As SqlResultRow)
Dim sql As String
sql = "UPDATE Planning.CustomerGroups SET Description = ?, DateUpdated = ? WHERE Id = ?;"
cmd.QuickExecuteNonQuery sql, value("description"), Now, value("id")
End Sub
Public Function Count() As Long
Dim sql As String
sql = "SELECT COUNT(*) FROM Planning.CustomerGroups;"
Count = cmd.QuickSelectSingleValue(sql)
End Function
Private Sub IRepository_Add(ByVal value As SqlResultRow)
Add value
End Sub
Private Function IRepository_Count() As Long
IRepository_Count = Count
End Function
Private Function IRepository_GetAll() As SqlResult
Set IRepository_GetAll = GetAll
End Function
Private Function IRepository_GetById(ByVal id As Long) As SqlResultRow
Set IRepository_GetById = GetById(id)
End Function
Private Function IRepository_NewItem(ByVal model As SqlResult, ByVal values As Scripting.IDictionary) As SqlResultRow
Set IRepository_NewItem = NewItem(model, values)
End Function
Private Sub IRepository_Remove(ByVal id As Long)
Remove id
End Sub
Private Sub IRepository_Update(ByVal id As Long, ByVal value As SqlResultRow)
Update id, value
End Sub
MockRepository class module
By property-injecting a mock implementation of this IRepository interface into a Presenter, I can run the UI and test every feature, without hitting the database - and I can work offline on implementing the other features.
Here's the mock implementation in question:
Option Explicit
Private FieldNames As List
Private Items As List
Implements IRepository
Implements IStringRepresentable
Public Sub SetModel(model As SqlResult)
Set FieldNames = model.FieldNames
Set Items = New List
Dim row As SqlResultRow
For Each row In model
Items.Add row
Next
End Sub
Private Function MockSqlResult() As SqlResult
Dim result As New SqlResult
Dim name As Variant
For Each name In FieldNames
result.AddFieldName name
Next
Dim row As SqlResultRow
For Each row In Items
result.AddValue row
Next
Set MockSqlResult = result
End Function
Public Function Create(model As SqlResult) As MockRepository
Dim result As New MockRepository
result.SetModel model
Set Create = result
End Function
Public Sub Add(ByVal value As SqlResultRow)
Dim newId As Long
newId = Items.Count + 1
If Items.Last("id") <= newId Then
newId = Items.Last("id") + 1
End If
value("id") = newId
Items.Add value
End Sub
Public Function GetAll() As SqlResult
Set GetAll = MockSqlResult
End Function
Public Function GetById(ByVal id As Long) As SqlResultRow
Set GetById = Items(id)
Dim row As SqlResultRow
For Each row In Items
If row("id") = id Then
Set GetById = row
Exit Function
End If
Next
End Function
Public Sub Remove(ByVal id As Long)
Items.Remove GetById(id)
End Sub
Public Sub Update(ByVal id As Long, ByVal value As SqlResultRow)
Dim row As SqlResultRow
Set row = GetById(id)
Dim i As Integer
For i = 1 To value.FieldCount
If LCase(FieldNames(i)) <> "id" Then
row(i - 1) = value(i - 1)
End If
Next
End Sub
Public Function Count() As Long
Count = Items.Count
End Function
Public Function NewItem(ByVal values As Dictionary) As SqlResultRow
Dim result As New SqlResultRow
Dim i As Integer
Dim model As New SqlResult
For i = LBound(values.Keys) To UBound(values.Keys)
model.AddFieldName values.Keys(i)
Next
For i = LBound(values.Items) To UBound(values.Items)
result.AddValue values.Items(i)
Next
Set result.ParentResult = model
Set NewItem = result
End Function
Public Function ToString() As String
Dim result As String
Dim Item As IStringRepresentable
For Each Item In Items
result = result & Item.ToString & vbNewLine
Next
ToString = result
End Function
Private Sub IRepository_Add(ByVal value As SqlResultRow)
Add value
End Sub
Private Function IRepository_Count() As Long
IRepository_Count = Count
End Function
Private Function IRepository_GetAll() As SqlResult
Set IRepository_GetAll = GetAll
End Function
Private Function IRepository_GetById(ByVal id As Long) As SqlResultRow
Set IRepository_GetById = Items(id)
End Function
Private Sub IRepository_Remove(ByVal id As Long)
Remove id
End Sub
Private Sub IRepository_Update(ByVal id As Long, ByVal value As SqlResultRow)
Update id, value
End Sub
Private Function IRepository_NewItem(ByVal model As SqlResult, ByVal values As Dictionary) As SqlResultRow
Set IRepository_NewItem = NewItem(values)
End Function
Private Function IStringRepresentable_ToString() As String
IStringRepresentable_ToString = ToString
End Function
Writing the above allowed me to write a TestModule that would bring up the UI and behave the same as with the MySQL backend - the idea isn't to write unit tests, it's just to be able to test/run it without the database, and it works like this:
TestModule code module
Option Explicit
Public Sub TestMaintainCustomerGroups()
Dim CustomerGroups As New MockRepository
Set CustomerGroups = CustomerGroups.Create(GetMockCustomerGroupsModel)
Dim Customers As New MockRepository
Set Customers = Customers.Create(GetMockCustomersModel)
Dim presenter As New CustomerGroupsPresenter
Set presenter.CustomerGroupsRepo = CustomerGroups
Set presenter.CustomersRepo = Customers
presenter.Show
End Sub
Private Function GetMockCustomerGroupsModel() As SqlResult
Dim model As New SqlResult
model.AddFieldName "Id"
model.AddFieldName "Description"
Dim row As SqlResultRow
Dim i As Integer
For i = 1 To 10
Set row = New SqlResultRow
Set row.ParentResult = model
row.AddValue i
row.AddValue "Test" & i
model.AddValue row
Next
Set GetMockCustomerGroupsModel = model
End Function
Private Function GetMockCustomersModel() As SqlResult
Dim model As New SqlResult
model.AddFieldName "Id"
model.AddFieldName "Code"
model.AddFieldName "Name"
model.AddFieldName "CustomerGroupId"
Dim row As SqlResultRow
Dim i As Integer
For i = 1 To 10
Set row = New SqlResultRow
Set row.ParentResult = model
row.AddValue i
row.AddValue 1000 + i
row.AddValue "Customer" & i
row.AddValue 1
model.AddValue row
Next
Set GetMockCustomersModel = model
End Function
I think we can call this dependency-injection in vba!
