Zestaw rekordów MS-Access i moduł klas

Wprowadzenie.

Tutaj zbudujemy moduł klasy do zadań przetwarzania danych, DAO.Recordset Obiekt zostanie przekazany do obiektu klasy niestandardowej. Ponieważ jest to obiekt, który przechodzi do naszej klasy niestandardowej, potrzebujemy Set iPobierz Para Procedura właściwości do przypisywania i pobierania wartości obiektu lub jego właściwości.

Mamy mały stolik:Tabela1 , z kilkoma zapisami w nim. Oto obraz tabeli 1.

Powyższa tabela zawiera tylko cztery pola:opis, ilość, cena jednostkowa i cena całkowita. Pole TotalPrice jest puste.

Jednym z zadań naszego modułu klasy jest aktualizacja pola ceny całkowitej o iloczyn Qty * cena jednostkowa.
Moduł klasy ma podprogram do sortowania danych w polu określonym przez użytkownika i zrzuca listę w oknie debugowania.
Inny podprogram tworzy kopię tabeli z nową nazwą, po posortowaniu danych na podstawie numeru kolumny podanego jako parametr.

Moduł klasy ClsRecUpdate.

Otwórz bazę danych dostępu i otwórz okno VBA.
Wstaw moduł klasy.
Zmień wartość właściwości nazwy na ClsRecUpdate .

Skopiuj i wklej następujący kod do modułu Class i zapisz moduł:

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

Właściwość rstB jest zadeklarowana jako obiekt DAO.Recordset.

Za pomocą procedury Set Property można przekazać obiekt zestawu rekordów do klasy ClsRecUpdate Obiekt.

Aktualizacja() Podprogram akceptuje liczby z trzech kolumn (w oparciu o numery kolumn 0) jako parametry do obliczania i aktualizowania trzeciej kolumny parametru o iloczyn pierwszej kolumny * drugiej kolumny.

DataSort() podprogram Sortuje rekordy w porządku rosnącym na podstawie numeru kolumny przekazanego jako parametr.

Typ danych Kolumna sortowania musi mieć wartość Liczba, Waluta lub Ciąg. Inne typy danych są ignorowane.

Lista rekordów zostanie zrzucona w oknie debugowania. Lista pól będzie ograniczona tylko do pięciu pól, jeśli źródło rekordów zawiera ich więcej, pozostałe pola są ignorowane.

TblCreate() podprogram posortuje dane w oparciu o numer kolumny przekazany jako parametr i utworzy tabelę o nowej nazwie. Parametr jest opcjonalny, jeśli numer kolumny nie zostanie przekazany jako parametr, tabela zostanie posortowana według danych w pierwszej kolumnie, jeśli typ danych kolumny jest prawidłowym typem. Oryginalna nazwa tabeli zostanie zmodyfikowana i dodana za pomocą ciągu „_2” do oryginalnej nazwy. Jeśli nazwa tabeli źródłowej to Tabela1 wtedy nowa nazwa tabeli to Table1_2 .

Program testowy dla ClsUpdate.

Przetestujmy ClsRecUpdate Obiekt klasy z małym programem.

Kod programu testowego podano poniżej:

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

Możesz przekazać dowolny zestaw rekordów, aby przetestować obiekt klasy.

Możesz przekazać dowolne numery kolumn w celu aktualizacji konkretnej kolumny. Numery kolumn niekoniecznie muszą być kolejnymi numerami. Ale trzeci parametr numer kolumny jest kolumną docelową do aktualizacji. Pierwszy parametr jest mnożony przez parametr drugiej kolumny, aby otrzymać wartość wynikową do aktualizacji. Możesz zmodyfikować kod modułu klasy, aby wykonać dowolną inną operację, którą chcesz wykonać na stole.

Wybór typu danych Kolumna sortowania może być tylko typu String, Numeric lub Currency. Inne typy są ignorowane. Numery kolumn zestawu rekordów są oparte na 0, co oznacza, że numer pierwszej kolumny to 0, druga kolumna to 1 i tak dalej.

Lista wszystkich linków na ten temat.

Moduł klasy MS-Access i VBA
Tablice obiektów klasy MS-Access VBA
Klasa bazowa MS-Access i obiekty pochodne
Klasa podstawowa VBA i obiekty pochodne-2
Warianty klasy bazowej i obiektów pochodnych
Ms-Access Recordset and Class Module
Dostęp do modułu klas i klas opakowujących
Transformacja funkcjonalności klasy opakowującej
Podstawy dostępu do MS i obiektów kolekcji
Moduł klasy Ms-Access i obiekt kolekcji
Rekordy tabeli w obiekcie i formularzu kolekcji
Podstawy obiektów słownikowych
Podstawy obiektów słownika-2
Sortowanie kluczy obiektów i elementów słownika
Wyświetl rekordy ze słownika do formularza
Dodaj obiekty klasy jako elementy słownika
Aktualizuj element słownika obiektów klasy w formularzu