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.
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).