MS-Access-recordset en klassenmodule

Inleiding.

Hier zullen we een klassenmodule bouwen voor gegevensverwerkingstaken, een DAO.Recordset Object wordt doorgegeven aan het Custom Class Object. Aangezien het een object is dat wordt doorgegeven aan onze aangepaste klasse, hebben we de Set . nodig en Ontvang Eigenschap Procedurepaar om het object of zijn eigenschapswaarden toe te wijzen en op te halen.

We hebben een kleine tabel:Tabel1 , met weinig records erin. Hier is de afbeelding van Tabel 1.

De bovenstaande tabel heeft slechts vier velden:Desc, Qty, UnitPrice en TotalPrice. Het veld TotalPrice is leeg.

Een van de taken van onze Klasse-module is om het veld TotalPrice bij te werken met het product Qty * UnitPrice.
De klassenmodule heeft een subroutine om de gegevens te sorteren in het door de gebruiker opgegeven veld, en dumpt een vermelding in het foutopsporingsvenster.
Een andere subroutine maakt een kopie van de tabel met een nieuwe naam, nadat de gegevens zijn gesorteerd op basis van het kolomnummer dat als parameter is opgegeven.

ClsRecUpdate-klassemodule.

Open uw Access-database en open het VBA-venster.
Een klasmodule invoegen.
Wijzig de waarde van de eigenschap Name in ClsRecUpdate .

Kopieer en plak de volgende code in de klassenmodule en sla de module op:

Option Compare Database
Option Explicit

Private rstB As DAO.Recordset

Public Property Get REC() As DAO.Recordset
   Set REC = rstB
End Property

Public Property Set REC(ByRef oNewValue As DAO.Recordset)
If Not oNewValue Is Nothing Then
   Set rstB = oNewValue
End If
End Property

Public Sub Update(ByVal Source1Col As Integer, ByVal Source2Col As Integer, ByVal updtcol As Integer)
'Updates a Column with the product of two other columns
Dim col As Integer

col = rstB.Fields.Count

'Validate Column Parameters
If Source1Col > col Or Source2Col > col Or updtcol > col Then
    MsgBox "One or more Column Number(s) out of bound!", vbExclamation, "Update()"
    Exit Sub
End If

'Update Field
On Error GoTo Update_Err
rstB.MoveFirst
Do While Not rstB.EOF
   rstB.Edit
     With rstB
      .Fields(updtcol).Value = .Fields(Source1Col).Value * .Fields(Source2Col).Value
      .Update
      .MoveNext
     End With
Loop

Update_Exit:
rstB.MoveFirst
Exit Sub

Update_Err:
MsgBox Err & " : " & Err.Description, vbExclamation, "Update()"
Resume Update_Exit
End Sub

Public Sub DataSort(ByVal intCol As Integer)
Dim cols As Long, colType
Dim colnames() As String
Dim k As Long, colmLimit As Integer
Dim strTable As String, strSortCol As String
Dim strSQL As String
Dim db As Database, rst2 As DAO.Recordset

On Error GoTo DataSort_Err

cols = rstB.Fields.Count - 1
strTable = rstB.Name
strSortCol = rstB.Fields(intCol).Name

'Validate Sort Column Data Type
colType = rstB.Fields(intCol).Type
Select Case colType
    Case 3 To 7, 10
        strSQL = "SELECT " & strTable & ".* FROM " & strTable & " ORDER BY " & strTable & ".[" & strSortCol & "];"
        Debug.Print "Sorted on " & rstB.Fields(intCol).Name & " Ascending Order"

    Case Else
        strSQL = "SELECT " & strTable & ".* FROM " & strTable & ";"

        Debug.Print "// SORT: COLUMN: <<" & strSortCol & " Data Type Invalid>> Valid Type: String,Number & Currency //"
        Debug.Print "Data Output in Unsorted Order"
End Select

Set db = CurrentDb
Set rst2 = db.OpenRecordset(strSQL)

ReDim colnames(0 To cols) As String

'Save Field Names in Array to Print Heading
For k = 0 To cols
   colnames(k) = rst2.Fields(k).Name
Next

'Print Section
Debug.Print String(52, "-")

'Print Column Names as heading
If cols > 4 Then
   colmLimit = 4
Else
   colmLimit = cols
End If
For k = 0 To colmLimit
    Debug.Print colnames(k),
Next: Debug.Print
Debug.Print String(52, "-")

'Print records in Debug window
rst2.MoveFirst
Do While Not rst2.EOF
  For k = 0 To colmLimit 'Listing limited to 5 columns only
     Debug.Print rst2.Fields(k),
  Next k: Debug.Print
rst2.MoveNext
Loop

rst2.Close
Set rst2 = Nothing
Set db = Nothing

DataSort_Exit:
Exit Sub

DataSort_Err:
MsgBox Err & " : " & Err.Description, vbExclamation, "DataSort()"
Resume DataSort_Exit

End Sub

Public Sub TblCreate(Optional SortCol As Integer = 0)
Dim dba As DAO.Database, tmp() As Variant
Dim tbldef As DAO.TableDef
Dim fld As DAO.Field, idx As DAO.Index
Dim rst2 As DAO.Recordset, i As Integer, fldcount As Integer
Dim strTable As String, rows As Long, cols As Long

On Error Resume Next

strTable = rstB.Name & "_2"
Set dba = CurrentDb

On Error Resume Next
TryAgain:
Set rst2 = dba.OpenRecordset(strTable)
If Err > 0 Then
  Set tbldef = dba.CreateTableDef(strTable)
  Resume Continue
Else
  rst2.Close
  dba.TableDefs.Delete strTable
  dba.TableDefs.Refresh
  GoTo TryAgain
End If
Continue:
On Error GoTo TblCreate_Err

fldcount = rstB.Fields.Count - 1
ReDim tmp(0 To fldcount, 0 To 1) As Variant

'Save Source File Field Names and Data Type
For i = 0 To fldcount
    tmp(i, 0) = rstB.Fields(i).Name: tmp(i, 1) = rstB.Fields(i).Type
Next
'Create Fields and Index for new table
For i = 0 To fldcount
   tbldef.Fields.Append tbldef.CreateField(tmp(i, 0), tmp(i, 1))
Next
'Create index to sort data
Set idx = tbldef.CreateIndex("NewIndex")
With idx
   .Fields.Append .CreateField(tmp(SortCol, 0))
End With
'Add Tabledef and index to database
tbldef.Indexes.Append idx
dba.TableDefs.Append tbldef
dba.TableDefs.Refresh

'Add records to the new table
Set rst2 = dba.OpenRecordset(strTable, dbOpenTable)
rstB.MoveFirst 'reset to the first record
Do While Not rstB.EOF
   rst2.AddNew 'create record in new table
    For i = 0 To fldcount
        rst2.Fields(i).Value = rstB.Fields(i).Value
    Next
   rst2.Update
rstB.MoveNext 'move to next record
Loop
rstB.MoveFirst 'reset record pointer to the first record
rst2.Close

Set rst2 = Nothing
Set tbldef = Nothing
Set dba = Nothing

MsgBox "Sorted Data Saved in " & strTable

TblCreate_Exit:
Exit Sub

TblCreate_Err:
MsgBox Err & " : " & Err.Description, vbExclamation, "TblCreate()"
Resume TblCreate_Exit

End Sub

De eigenschap rstB is gedeclareerd als een DAO.Recordset Object.

Via de Set Property Procedure kan een recordset-object worden doorgegeven aan de klasse ClsRecUpdate Voorwerp.

De Update() Subroutine accepteert driekolomsnummers (0 gebaseerde kolomnummers) als parameters om de derde parameterkolom te berekenen en bij te werken met het product van de eerste kolom * tweede kolom.

De DataSort() subroutine Sorteert de records in oplopende volgorde op basis van het kolomnummer dat als parameter is doorgegeven.

Het gegevenstype Sorteerkolom moet Getal of Valuta of Tekenreeks zijn. Andere gegevenstypen worden genegeerd.

Een lijst van de records wordt in het foutopsporingsvenster gedumpt. De lijst met velden is beperkt tot slechts vijf velden. Als de recordbron er meer heeft, worden de rest van de velden genegeerd.

De TblCreate() subroutine sorteert de gegevens op basis van het kolomnummer dat als parameter is doorgegeven en maakt een tabel met een nieuwe naam. De parameter is optioneel, als een kolomnummer niet als parameter wordt doorgegeven, wordt de tabel gesorteerd op gegevens in de eerste kolom als het gegevenstype van de kolom een geldig type is. De oorspronkelijke naam van de tabel wordt gewijzigd en toegevoegd met de tekenreeks “_2” naar de oorspronkelijke naam. Als de naam van de brontabel Tabel1 is dan is de nieuwe tabelnaam Table1_2 .

Het testprogramma voor ClsUpdate.

Laten we de ClsRecUpdate . testen Class Object met een klein programma.

De code van het testprogramma wordt hieronder gegeven:

Public Sub DataProcess()
Dim db As DAO.Database
Dim rstA As DAO.Recordset

Dim R_Set As ClsRecUpdate
Set R_Set = New ClsRecUpdate

Set db = CurrentDb
Set rstA = db.OpenRecordset("Table1", dbOpenTable)

'send Recordset Object to Class Object
Set R_Set.REC = rstA

'Update Total Price Field
Call R_Set.Update(1, 2, 3) 'col3=col1 * col2

'Sort Ascending Order on UnitPrice column & Print in Debug Window
Call R_Set.DataSort(2)

'Create New Table Sorted on UnitPrice in Ascending Order
Call R_Set.TblCreate(2) 
Set rstA = Nothing
Set db = Nothing
xyz:
End Sub

Je mag elke recordset doorgeven om het Class Object te testen.

U kunt alle kolomnummers doorgeven voor het bijwerken van een bepaalde kolom. De kolomnummers hoeven niet per se opeenvolgende nummers te zijn. Maar de derde kolomnummerparameter is de doelkolom die moet worden bijgewerkt. De eerste parameter wordt vermenigvuldigd met de tweede kolomparameter om te komen tot de resultaatwaarde die moet worden bijgewerkt. U kunt de code van de klassemodule wijzigen om elke andere bewerking die u op de tafel wilt uitvoeren, uit te voeren.

Selectie van het gegevenstype Sorteerkolom mag alleen String, Numeriek of Valutatype zijn. Andere typen worden genegeerd. De kolomnummers van de recordset zijn gebaseerd op 0, wat betekent dat het eerste kolomnummer 0 is, de tweede kolom 1, enzovoort.

MS-Access-recordset en klassenmodule

Inleiding.

ClsRecUpdate-klassemodule.

Het testprogramma voor ClsUpdate.

Lijst met alle links over dit onderwerp.