MS-Access Recordset a Class Module

Úvod.

Zde vytvoříme modul třídy pro úlohy zpracování dat, DAO.Recordset Objekt bude předán objektu vlastní třídy. Protože se jedná o objekt, který přechází do naší vlastní třídy, potřebujeme Set a Získat Vlastnost Postup pro přiřazení a načtení objektu nebo jeho hodnot vlastností.

Máme malou tabulku:Tabulka1 s několika záznamy. Zde je obrázek tabulky1.

Výše uvedená tabulka má pouze čtyři pole:Desc, Qty, UnitPrice a TotalPrice. Pole TotalPrice je prázdné.

• Jedním z úkolů našeho modulu třídy je aktualizovat pole Celková cena součinem Množství * Jednotková cena.
• Třídový modul má podprogram pro třídění dat v poli zadaném uživatelem a vypisuje výpis v ladicím okně.
• Další podprogram vytvoří kopii tabulky s novým názvem po seřazení dat podle čísla sloupce poskytnutého jako parametr.

Modul třídy ClsRecUpdate.

1. Otevřete databázi Accessu a otevřete okno VBA.
2. Vložte modul třídy.
3. Změňte jeho hodnotu vlastnosti Name na ClsRecUpdate .
4. Zkopírujte a vložte následující kód do modulu třídy a modul uložte:
   

   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
   
   

Vlastnost rstB je deklarována jako objekt DAO.Recordset.

Prostřednictvím procedury nastavení vlastnosti lze objekt sady záznamů předat třídě ClsRecUpdate Objekt.

Funkce Update() Podprogram přijímá čísla ve třech sloupcích (čísla sloupců založená na 0) jako parametry pro výpočet a aktualizaci třetího sloupce parametru součinem prvního sloupce * druhého sloupce.

Funkce DataSort() podprogram Seřadí záznamy ve vzestupném pořadí na základě čísla sloupce předaného jako parametr.

Datový typ Sloupec řazení musí být Číslo nebo Měna nebo Řetězec. Ostatní datové typy jsou ignorovány.

V ladicím okně se zobrazí výpis záznamů. Výpis polí bude omezen pouze na pět polí, pokud jich má zdroj záznamu více, pak jsou ostatní pole ignorována.

Funkce TblCreate() podprogram seřadí data na základě čísla sloupce předaného jako parametr a vytvoří tabulku s novým názvem. Parametr je volitelný, pokud není jako parametr předáno číslo sloupce, bude tabulka seřazena podle dat v prvním sloupci, pokud je datový typ sloupce platný. Původní název tabulky bude upraven a doplněn o řetězec “_2” k původnímu názvu. Pokud je název zdrojové tabulky Tabulka1 pak nový název tabulky bude Tabulka1_2 .

Testovací program pro ClsUpdate.

Pojďme otestovat ClsRecUpdate Class Object s malým programem.

Kód testovacího programu je uveden níže:

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

Můžete předat jakoukoli sadu záznamů k testování objektu třídy.

Pro aktualizaci konkrétního sloupce můžete předat libovolná čísla sloupců. Čísla sloupců nemusí být nutně po sobě jdoucí čísla. Ale třetí parametr čísla sloupce je cílový sloupec, který se má aktualizovat. První parametr se vynásobí parametrem druhého sloupce, aby se dospělo k výsledné hodnotě, která se má aktualizovat. Můžete upravit kód modulu třídy, abyste mohli provést jakoukoli jinou operaci, kterou chcete na stole provést.

Výběr datového typu Sloupec řazení musí být pouze Řetězec, Číselný nebo Typ měny. Ostatní typy jsou ignorovány. Čísla sloupců sady záznamů jsou založena na 0, což znamená, že číslo prvního sloupce je 0, druhého sloupce je 1 a tak dále.

Seznam všech odkazů na toto téma.

1. MS-Access Class Module a VBA
2. Pole objektů třídy VBA MS Access
3. Základní třída MS-Access a odvozené objekty
4. Základní třída VBA a odvozené objekty-2
5. Základní třída a varianty odvozených objektů
6. Sada záznamů a modul třídy Ms-Access
7. Přístup k modulu třídy a třídám Wrapper
8. Transformace funkčnosti třídy Wrapper
9. Základy přístupu a shromažďovacích objektů
10. Modul třídy Ms-Access a objekt kolekce
11. Záznamy tabulek v objektu a formuláři kolekce
12. Základy objektů slovníku
13. Základy objektů slovníku-2
14. Řazení klíčů a položek objektů slovníku
15. Zobrazení záznamů ze slovníku do formuláře
16. Přidat objekty třídy jako položky slovníku
17. Aktualizovat položku slovníku objektů třídy ve formuláři