Skip to main content
replaced http://codereview.stackexchange.com/ with https://codereview.stackexchange.com/
Source Link

Either properly encapsulate the fields and expose properties, or go with @RubberDuck's last suggestion@RubberDuck's last suggestion and create a Public Type Part in a standard code module.

Either properly encapsulate the fields and expose properties, or go with @RubberDuck's last suggestion and create a Public Type Part in a standard code module.

Either properly encapsulate the fields and expose properties, or go with @RubberDuck's last suggestion and create a Public Type Part in a standard code module.

Source Link
Mathieu Guindon
  • 75.6k
  • 18
  • 194
  • 468

Private cn As ADODB.Connection ' global due to being passed around

Well that is one confusing comment. The visibility of cn is Private, its scope is therefore restricted to Module1. Was it globally scoped (with a Public, or the deprecated Global access modifier) in a previous version? I like that the comment says why, but the wording is confusing. Consider:

Private cn As ADODB.Connection ' module-level due to being passed around

Actually this comment is also a lie - the connection isn't passed around, but I'll get back to that.


Another comment caught my eye:

Set cn = cnWrapper.GetConnection    ' Gets an active ADODB.Connection

If cnWrapper.GetConnection is returning an active ADODB.Connection, then why bother doing this?

' if sucessfully connected then
If (cn.State And adStateOpen) = adStateOpen Then

If the COM-visible managed (.net) code returned an active/open connection or Nothing, then the VBA client code wouldn't need to be bothered with adState enums, and the Main procedure could either return early (for a silent fail.. not good), or better, blow up with an object variable not set error, that should be handled in an error-handling subroutine.


I'm not sure I like this whole idea of using a COM-visible class library to "hide" connection string details to VBA code.

I like to consider ADODB.Connection objects like I do IDisposable implementations in .net - the object that's creating it should be responsible for cleaning it up... and that's not what you're doing here: you're creating an ADODB.Connection in a place that is only making maintenance harder than it needs to be. The day the SQL instance or connection provider changes, you have a lot of work ahead of you.

And the connection string isn't really hidden from the client:

Dim topSecretConnectionString = cn.ConnectionString
Debug.Print topSecretConnectionString

Anyone that can access the code can also access the connection string.

Unless it's the connection that you hide from the client VBA code, there's no much gain with the COM-visible library approach.

I believe there's a potential performance gain in using parameterized queries instead of concatenating the values into the WHERE clause:

Public Function FromPartId() As String
    FromPartId = "SELECT  PART.PartId as 'PART ID' , " & _
                 "        PART.Type as 'TYPE' , " & _
                 "        PART.Name as 'PART NAME', " & _
                 "        PART.Price as 'PRICE' " & _
                 "FROM " & _
                 "        PART " & _
                 "WHERE " & _
                 "        PART.PartId = ?"
End Function

Public Function Sons() As String
    Sons = "SELECT  PARTARC.Son " & _
           "FROM " & _
           "        PARTARC " & _
           "            left join PART on PART.PartId = PARTARC.Son " & _
           "WHERE " & _
           "         PARTARC.Part = ?"
End Function

I noticed the Sons function returned an implicit Variant - I've made it an explicit String here. Obviously when you're using parameters like this, you can't just populate a Recordset, you need a parameterized Command. Here's how I've solved this problem:

###SqlCommand

Here is a simplified version that only exposes the members that take an ADODB.Connection parameter:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "SqlCommand"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private Type TSqlCommand
    Converter As New AdoValueConverter
    connString As String
    ResultFactory As New SqlResult
End Type

Private this As TSqlCommand

Public Function Create(ByVal connString As String) As SqlCommand
    Dim result As New SqlCommand
    result.ConnectionString = connString
    Set Create = result
End Function

Public Property Get ConnectionString() As String
    ConnectionString = this.connString
End Property

Public Property Let ConnectionString(ByVal value As String)
    this.connString = value
End Property

Public Property Get ParameterFactory() As AdoValueConverter
Attribute ParameterFactory.VB_Description = "Gets an object that can create ADODB Parameters and configure how ADODB Parameters are created."
    Set ParameterFactory = this.Converter
End Property

Public Function Execute(connection As ADODB.connection, ByVal sql As String, ParamArray parameterValues()) As ADODB.Recordset
Attribute Execute.VB_Description = "Returns a connected ADODB.Recordset that contains the results of the specified parameterized query."
'Returns a connected ADODB.Recordset that contains the results of the specified parameterized query.

    Dim parameters() As Variant
    parameters = parameterValues
    
    Set Execute = ExecuteInternal(connection, sql, parameters)
    
End Function

Public Function ExecuteNonQuery(connection As ADODB.connection, ByVal sql As String, ParamArray parameterValues()) As Boolean
Attribute ExecuteNonQuery.VB_Description = "Returns a Boolean that indicates whether the specified parameterized SQL command (update, delete, etc.) executed without throwing an error."
'Returns a Boolean that indicates whether the specified parameterized SQL command (update, delete, etc.) executed without throwing an error.

    Dim parameters() As Variant
    parameters = parameterValues
    
    ExecuteNonQuery = ExecuteNonQueryInternal(connection, sql, parameters)
    
End Function

Public Function SelectSingleValue(connection As ADODB.connection, ByVal sql As String, ParamArray parameterValues()) As Variant
Attribute SelectSingleValue.VB_Description = "Returns the value of the first field of the first record of the results of the specified parameterized SQL query."
'Returns the value of the first field of the first record of the results of the specified parameterized SQL query.

    Dim parameters() As Variant
    parameters = parameterValues
    
    SelectSingleValue = SelectSingleValueInternal(connection, sql, parameters)
    
End Function

Private Function CreateCommand(connection As ADODB.connection, ByVal cmdType As ADODB.CommandTypeEnum, ByVal sql As String, parameterValues() As Variant) As ADODB.Command
    
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = connection
    cmd.CommandType = cmdType
    cmd.CommandText = sql
        
    Dim i As Integer
    Dim value As Variant
    
    For i = LBound(parameterValues) To UBound(parameterValues)
        value = parameterValues(i)
        If TypeName(value) <> "Variant()" Then cmd.parameters.Append ToSqlInputParameter(value)
    Next
    
    Set CreateCommand = cmd

End Function

Private Function ToSqlInputParameter(ByVal value As Variant) As ADODB.Parameter
    
    If IsObject(value) Then Err.Raise vbObjectError + 911, "SqlCommand.ToSqlInputParameter", "Invalid argument, parameter value cannot be an object."
    
    Dim result As ADODB.Parameter
    Set result = CallByName(this.Converter, "To" & TypeName(value) & "Parameter", VbMethod, value, ADODB.ParameterDirectionEnum.adParamInput)
    
    Set ToSqlInputParameter = result
    
End Function

Private Function ExecuteInternal(connection As ADODB.connection, ByVal sql As String, parameterValues()) As ADODB.Recordset
    
    Dim cmd As ADODB.Command
    Set cmd = CreateCommand(connection, adCmdText, sql, parameterValues)
    
    Set ExecuteInternal = cmd.Execute
    
End Function

Private Function ExecuteNonQueryInternal(connection As ADODB.connection, ByVal sql As String, parameterValues()) As Boolean

    Dim cmd As ADODB.Command
    Set cmd = CreateCommand(connection, adCmdText, sql, parameterValues)
    
    Dim result As Boolean
    On Error Resume Next
        cmd.Execute
        result = (Err.Number = 0)
    On Error GoTo 0
    
    ExecuteNonQueryInternal = result
    
End Function

Private Function SelectSingleValueInternal(connection As ADODB.connection, ByVal sql As String, parameterValues()) As Variant
    
    Dim parameters() As Variant
    parameters = parameterValues
    
    Dim cmd As ADODB.Command
    Set cmd = CreateCommand(connection, adCmdText, sql, parameters)
    
    Dim rs As ADODB.Recordset
    Set rs = cmd.Execute
    
    Dim result As Variant
    If Not rs.BOF And Not rs.EOF Then result = rs.fields(0).value
    
    rs.Close
    Set rs = Nothing
    
    SelectSingleValueInternal = result

End Function

###AdoValueConverter

This class makes creating ADODB parameters literally automagic, so the SqlCommand's clients can just pass in whatever parameters they need:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "AdoValueConverter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Type TypeMappings
    OptionAllStrings As Boolean
    OptionMapGuidString As Boolean
    StringDateFormat As String
    BooleanMap As ADODB.DataTypeEnum
    StringMap As ADODB.DataTypeEnum
    GuidMap As ADODB.DataTypeEnum
    DateMap As ADODB.DataTypeEnum
    ByteMap As ADODB.DataTypeEnum
    IntegerMap As ADODB.DataTypeEnum
    LongMap As ADODB.DataTypeEnum
    DoubleMap As ADODB.DataTypeEnum
    SingleMap As ADODB.DataTypeEnum
    CurrencyMap As ADODB.DataTypeEnum
End Type

Private mappings As TypeMappings
Option Explicit

Private Sub Class_Initialize()
    
    mappings.OptionAllStrings = False
    mappings.OptionMapGuidString = True
    mappings.StringDateFormat = "yyyy-MM-dd"
    
    mappings.BooleanMap = adBoolean
    mappings.ByteMap = adInteger
    mappings.CurrencyMap = adCurrency
    mappings.DateMap = adDate
    mappings.DoubleMap = adDouble
    mappings.GuidMap = adGUID
    mappings.IntegerMap = adInteger
    mappings.LongMap = adInteger
    mappings.SingleMap = adSingle
    mappings.StringMap = adVarChar
    
End Sub

Public Property Get OptionAllStrings() As Boolean
Attribute OptionAllStrings.VB_Description = "Gets or sets a value that indicates whether parameters are to be treated as strings, regardless of the type."
    OptionAllStrings = mappings.OptionAllStrings
End Property

Public Property Let OptionAllStrings(ByVal value As Boolean)
    mappings.OptionAllStrings = value
End Property

Public Property Get OptionMapGuidStrings() As Boolean
Attribute OptionMapGuidStrings.VB_Description = "Gets or sets a value that indicates whether to map a string that matches a GUID pattern as a GUID parameter."
    OptionMapGuidStrings = mappings.OptionMapGuidString
End Property

Public Property Let OptionMapGuidStrings(ByVal value As Boolean)
    mappings.OptionMapGuidString = value
End Property

Public Property Get StringDateFormat() As String
    StringDateFormat = mappings.StringDateFormat
End Property

Public Property Let StringDateFormat(ByVal value As String)
    mappings.StringDateFormat = value
End Property


Public Property Get BooleanMapping() As ADODB.DataTypeEnum
    BooleanMapping = mappings.BooleanMap
End Property

Public Property Let BooleanMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.BooleanMap = value
End Property

Public Property Get ByteMapping() As ADODB.DataTypeEnum
    ByteMapping = mappings.ByteMap
End Property

Public Property Let ByteMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.ByteMap = value
End Property

Public Property Get CurrencyMapping() As ADODB.DataTypeEnum
    CurrencyMapping = mappings.CurrencyMap
End Property

Public Property Let CurrencyMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.CurrencyMap = value
End Property

Public Property Get DateMapping() As ADODB.DataTypeEnum
    DateMapping = mappings.DateMap
End Property

Public Property Let DateMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.DateMap = value
End Property

Public Property Get DoubleMapping() As ADODB.DataTypeEnum
    DoubleMapping = mappings.DoubleMap
End Property

Public Property Let DoubleMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.DoubleMap = value
End Property

Public Property Get GuidMapping() As ADODB.DataTypeEnum
    GuidMapping = mappings.GuidMap
End Property

Public Property Let GuidMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.GuidMap = value
End Property

Public Property Get IntegerMapping() As ADODB.DataTypeEnum
    IntegerMapping = mappings.IntegerMap
End Property

Public Property Let IntegerMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.IntegerMap = value
End Property

Public Property Get LongMapping() As ADODB.DataTypeEnum
    LongMapping = mappings.LongMap
End Property

Public Property Let LongMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.LongMap = value
End Property

Public Property Get SingleMapping() As ADODB.DataTypeEnum
    SingleMapping = mappings.SingleMap
End Property

Public Property Let SingleMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.SingleMap = value
End Property

Public Property Get StringMapping() As ADODB.DataTypeEnum
    StringMapping = mappings.StringMap
End Property

Public Property Let StringMapping(ByVal value As ADODB.DataTypeEnum)
    mappings.StringMap = value
End Property

Public Function ToNamedParameter(ByVal name As String, ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    Dim result As ADODB.Parameter
    Set result = CallByName(Me, "To" & TypeName(value) & "Parameter", VbMethod, value, direction)
    
    result.name = name
    Set ToNamedParameter = result
    
End Function


Public Function ToStringParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
   
    Dim stringValue As String
    stringValue = CStr(value)
    
    If Not mappings.OptionAllStrings Then
        If IsGuidString(stringValue) Then ' split on 2 conditions for performance: evaluating IsGuidString uses regular expressions
            Set ToStringParameter = ToGuidParameter(value, direction)
            Exit Function
        End If
    End If
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.StringMap
        .direction = direction
        .Size = Len(stringValue)
        .value = stringValue
    End With
    
    Set ToStringParameter = result
    
End Function

Public Function ToGuidParameter(ByVal value As String, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    If mappings.OptionAllStrings Then
        Set ToGuidParameter = ToStringParameter(value, direction)
        Exit Function
    End If
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.GuidMap
        .direction = direction
        .value = value
    End With
    
    Set ToGuidParameter = result
    
End Function

Private Function IsGuidString(ByVal value As String) As Boolean
    
    Dim regex As New RegExp
    regex.pattern = "\b[A-F0-9]{8}(?:-[A-F0-9]{4}){3}-[A-F0-9]{12}\b"
    
    Dim matches As MatchCollection
    Set matches = regex.Execute(UCase(value))
    
    IsGuidString = matches.Count <> 0
    
    Set regex = Nothing
    Set matches = Nothing
    
End Function

Public Function ToIntegerParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    If mappings.OptionAllStrings Then
        Set ToIntegerParameter = ToStringParameter(value, direction)
        Exit Function
    End If
    
    Dim integerValue As Long
    integerValue = CLng(value)
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.IntegerMap
        .direction = direction
        .value = integerValue
    End With
    
    Set ToIntegerParameter = result
    
End Function

Public Function ToByteParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    If mappings.OptionAllStrings Then
        Set ToByteParameter = ToStringParameter(value, direction)
        Exit Function
    End If
    
    Dim byteValue As Byte
    byteValue = CByte(value)
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.ByteMap
        .direction = direction
        .value = byteValue
    End With
    
    Set ToByteParameter = result
    
End Function

Public Function ToLongParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    If mappings.OptionAllStrings Then
        Set ToLongParameter = ToStringParameter(value, direction)
        Exit Function
    End If
    
    Dim longValue As Long
    longValue = CLng(value)
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.LongMap
        .direction = direction
        .value = longValue
    End With
    
    Set ToLongParameter = result
    
End Function

Public Function ToDoubleParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    If mappings.OptionAllStrings Then
        Set ToDoubleParameter = ToStringParameter(value, direction)
        Exit Function
    End If
    
    Dim doubleValue As Double
    doubleValue = CDbl(value)
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.DoubleMap
        .direction = direction
        .value = doubleValue
    End With
    
    Set ToDoubleParameter = result
    
End Function

Public Function ToSingleParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    If mappings.OptionAllStrings Then
        Set ToSingleParameter = ToStringParameter(value, direction)
        Exit Function
    End If
    
    Dim singleValue As Single
    singleValue = CSng(value)
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.SingleMap
        .direction = direction
        .value = singleValue
    End With
    
    Set ToSingleParameter = result
    
End Function

Public Function ToCurrencyParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    If mappings.OptionAllStrings Then
        Set ToCurrencyParameter = ToStringParameter(value, direction)
        Exit Function
    End If
    
    Dim currencyValue As Currency
    currencyValue = CCur(value)
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.CurrencyMap
        .direction = direction
        .value = currencyValue
    End With
    
    Set ToCurrencyParameter = result
    
End Function

Public Function ToBooleanParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter

    If mappings.OptionAllStrings Then
        Set ToBooleanParameter = ToStringParameter(value, direction)
        Exit Function
    End If
    
    Dim boolValue As Boolean
    boolValue = CBool(value)
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.BooleanMap
        .direction = direction
        .value = boolValue
    End With
    
    Set ToBooleanParameter = result
    
End Function

Public Function ToDateParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter

    If mappings.OptionAllStrings Then
        Set ToDateParameter = ToStringParameter(Format(value, mappings.StringDateFormat), direction)
        Exit Function
    End If
    
    Dim dateValue As Date
    dateValue = CDate(value)
    
    Dim result As New ADODB.Parameter
    With result
        .Type = mappings.DateMap
        .direction = direction
        .value = dateValue
    End With
    
    Set ToDateParameter = result
    
End Function

With the above 2 classes, you can write parameterized queries without bloating up your code:

Function CreatePart(Id As Long, Optional theParent As Part) As Part

    Dim rs As ADODB.Recordset

    On Error GoTo SinglePartHandler
    Set rs = SqlCommand.Execute(cn, Queries.FromPartId, Id)

    '...
Function GetChildren(ByRef p As Part) As Parts

    Dim rs As ADODB.Recordset

    On Error GoTo ChildrenHandler
    Set rs = SqlCommand.Execute(cn, Queries.Sons, p.Id)

    '...

Note that CreatePart(Id As Long ...) passes the Id value ByRef implicitly; I doubt this is intentional, the value should be passed ByVal.

Also the indentation under On Error GoTo instructions isn't consistent; GetChildren has On Error GoTo ChildrenHandler twice, but only the 2nd instance indents the code underneath. I wouldn't add an indentation level after On Error instructions.


The Part class severely breaks encapsulation, by exposing public fields:

Public Id As Long
Public IsRoot As Boolean
Public Name As String
Public T As String ' * 1 <- yeah, I wish there was a Char type
Public Price As Double

Public Parent As Part
Public Children As Parts

Either properly encapsulate the fields and expose properties, or go with @RubberDuck's last suggestion and create a Public Type Part in a standard code module.

The Parts class doesn't seem to be doing much either - it's basically an add-only Collection. Why not just use a Collection? Why go through all this trouble just to prevent removing items? A variable named parts As New Collection would fit the bill just fine I find (note: not c, wink-wink).