diff options
| -rw-r--r-- | wizards/source/access2base/Recordset.xba | 91 |
1 files changed, 60 insertions, 31 deletions
diff --git a/wizards/source/access2base/Recordset.xba b/wizards/source/access2base/Recordset.xba index b16b15390097..0f7be5b01827 100644 --- a/wizards/source/access2base/Recordset.xba +++ b/wizards/source/access2base/Recordset.xba @@ -17,6 +17,7 @@ REM ---------------------------------------------------------------------------- Private _Type As String ' Must be RECORDSET Private _Name As String ' Unique, generated Private _This As Object +Private _Fields() As Variant Private _ParentName As String Private _ParentType As String Private _ParentDatabase As Object @@ -51,6 +52,7 @@ Private Sub Class_Initialize() _Type = OBJRECORDSET _Name = "" Set _This = Nothing + _Fields = Array() _ParentName = "" Set _ParentDatabase = Nothing _ParentType = "" @@ -371,6 +373,7 @@ Public Function mClose(ByVal Optional pbRemove As Boolean) As Variant ' If pbRemove = True, remove recordset from Recordsets collection Const cstThisSub = "Recordset.Close" +Dim i As Integer If _ErrorHandler() Then On Local Error Goto Exit_Function ' Do not stop execution Utils._SetCalledSub(cstThisSub) @@ -393,6 +396,13 @@ Const cstThisSub = "Recordset.Close" _BookmarkBeforeNew = Null _BookmarkLastModified = Null _IsClone = False + For i = 0 To UBound(_Fields) + If Not IsNull(_Fields(i)) Then + _Fields(i).Dispose() + Set _Fields(i) = Nothing + End If + Next i + _Fields = Array() Set RowSet = Nothing If IsMissing(pbRemove) Then pbRemove = True If pbRemove Then _ParentDatabase.RecordsetsColl.Remove(_Name) @@ -486,42 +496,61 @@ Const cstThisSub = "Recordset.Fields" End If Dim sObjects() As String, sObjectName As String, oObject As Object -Dim i As Integer, bFound As Boolean, oFields As Object +Dim i As Integer, oFields As Object, iIndex As Integer + + ' No argument, return a collection + If IsMissing(pvIndex) Then + Set oObject = New Collect + oObject._CollType = COLLFIELDS + oObject._ParentType = OBJRECORDSET + oObject._ParentName = _Name + Set oObject._ParentDatabase = _ParentDatabase + oObject._Count = RowSet.getColumns().Count + Goto Exit_Function + End If Set oFields = RowSet.getColumns() sObjects = oFields.ElementNames() - Select Case True - Case IsMissing(pvIndex) - Set oObject = New Collect - oObject._CollType = COLLFIELDS - oObject._ParentType = OBJRECORDSET - oObject._ParentName = _Name - Set oObject._ParentDatabase = _ParentDatabase - oObject._Count = UBound(sObjects) + 1 - Goto Exit_Function - Case VarType(pvIndex) = vbString - bFound = False + + ' Argument is the field name + If VarType(pvIndex) = vbString Then + iIndex = -1 ' Check existence of object and find its exact (case-sensitive) name - For i = 0 To UBound(sObjects) - If UCase(pvIndex) = UCase(sObjects(i)) Then - sObjectName = sObjects(i) - bFound = True - Exit For - End If - Next i - If Not bFound Then Goto Trace_NotFound - Case Else ' pvIndex is numeric - If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError - sObjectName = sObjects(pvIndex) - End Select + For i = 0 To UBound(sObjects) + If UCase(pvIndex) = UCase(sObjects(i)) Then + sObjectName = sObjects(i) + iIndex = i + Exit For + End If + Next i + If iIndex < 0 Then Goto Trace_NotFound + ' Argument is numeric + Else + If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError + sObjectName = sObjects(pvIndex) + iIndex = pvIndex + End If - Set oObject = New Field - oObject._Name = sObjectName - Set oObject.Column = oFields.getByName(sObjectName) - oObject._ParentName = _Name - oObject._ParentType = _Type - Set oObject._ParentDatabase = _ParentDatabase - Set oObject._ParentRecordset = _This + ' Check if field object already buffered in _Fields() array + If UBound(_Fields) < 0 Then ' Initialize _Fields + ReDim _Fields(0 To UBound(sObjects)) + For i = 0 To UBound(sObjects) + Set _Fields(i) = Nothing + Next i + End If + If Not IsNull(_Fields(iIndex)) Then + Set oObject = _Fields(iIndex) + ' Otherwise create new field object + Else + Set oObject = New Field + oObject._Name = sObjectName + Set oObject.Column = oFields.getByName(sObjectName) + oObject._ParentName = _Name + oObject._ParentType = _Type + Set oObject._ParentDatabase = _ParentDatabase + Set oObject._ParentRecordset = _This + Set _Fields(iIndex) = oObject + End If Exit_Function: Set Fields = oObject |