MS-Access Recordset und Klassenmodul

Einführung.

Hier bauen wir ein Klassenmodul für Datenverarbeitungsaufgaben, ein DAO.Recordset Das Objekt wird an das benutzerdefinierte Klassenobjekt übergeben. Da es sich um ein Objekt handelt, das an unsere benutzerdefinierte Klasse übergeben wird, benötigen wir das Set undAbrufen Eigenschaftsprozedurpaar zum Zuweisen und Abrufen des Objekts oder seiner Eigenschaftswerte.

Wir haben eine kleine Tabelle:Table1 , mit wenigen Aufzeichnungen darin. Hier ist das Bild von Table1.

Die obige Tabelle hat nur vier Felder:Desc, Qty, UnitPrice und TotalPrice. Das Feld TotalPrice ist leer.

Eine der Aufgaben unseres Klassenmoduls besteht darin, das Feld „TotalPrice“ mit dem Produkt aus Menge * Einzelpreis zu aktualisieren.
Das Klassenmodul hat eine Unterroutine zum Sortieren der Daten in dem vom Benutzer angegebenen Feld und gibt eine Auflistung im Debug-Fenster aus.
Eine weitere Subroutine erstellt eine Kopie der Tabelle mit einem neuen Namen, nachdem die Daten basierend auf der als Parameter bereitgestellten Spaltennummer sortiert wurden.

ClsRecUpdate-Klassenmodul.

Öffnen Sie Ihre Access-Datenbank und öffnen Sie das VBA-Fenster.
Fügen Sie ein Klassenmodul ein.
Ändern Sie den Namenseigenschaftswert in ClsRecUpdate .

Kopieren Sie den folgenden Code, fügen Sie ihn in das Klassenmodul ein und speichern Sie das Modul:

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

Die rstB-Eigenschaft wird als DAO.Recordset-Objekt deklariert.

Durch die Set-Property-Prozedur kann ein Recordset-Objekt an die Klasse ClsRecUpdate übergeben werden Objekt.

Das Update() Die Unterroutine akzeptiert dreispaltige Zahlen (auf 0 basierende Spaltenzahlen) als Parameter, um die dritte Parameterspalte mit dem Produkt der ersten Spalte * zweiten Spalte zu berechnen und zu aktualisieren.

Der DataSort() subroutine Sortiert die Datensätze in aufsteigender Reihenfolge basierend auf der als Parameter übergebenen Spaltennummer.

Der Datentyp der Sortierspalte muss Zahl, Währung oder Zeichenfolge sein. Andere Datentypen werden ignoriert.

Eine Auflistung der Datensätze wird im Debug-Fenster ausgegeben. Die Liste der Felder wird auf nur fünf Felder begrenzt, wenn die Datensatzquelle mehr als das hat, dann werden die restlichen Felder ignoriert.

Das TblCreate() Die Subroutine sortiert die Daten basierend auf der als Parameter übergebenen Spaltennummer und erstellt eine Tabelle mit einem neuen Namen. Der Parameter ist optional, wenn keine Spaltennummer als Parameter übergeben wird, wird die Tabelle nach Daten in der ersten Spalte sortiert, wenn der Datentyp der Spalte ein gültiger Typ ist. Der ursprüngliche Name der Tabelle wird geändert und mit dem String „_2“ ergänzt zum ursprünglichen Namen. Wenn der Name der Quelltabelle Table1 ist dann lautet der neue Tabellenname Table1_2 .

Das Testprogramm für ClsUpdate.

Lassen Sie uns das ClsRecUpdate testen Klassenobjekt mit einem kleinen Programm.

Der Code des Testprogramms ist unten angegeben:

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

Sie können jedes Recordset übergeben, um das Klassenobjekt zu testen.

Sie können beliebige Spaltennummern übergeben, um eine bestimmte Spalte zu aktualisieren. Die Spaltennummern müssen nicht unbedingt fortlaufende Nummern sein. Der dritte Parameter für die Spaltennummer ist jedoch die zu aktualisierende Zielspalte. Der erste Parameter wird mit dem zweiten Spaltenparameter multipliziert, um zu dem zu aktualisierenden Ergebniswert zu gelangen. Sie können den Code des Klassenmoduls ändern, um jede andere Operation auszuführen, die Sie auf der Tabelle ausführen möchten.

Die Auswahl des Datentyps „Spalte sortieren“ darf nur „Zeichenfolge“, „Numerisch“ oder „Währungstyp“ sein. Andere Typen werden ignoriert. Recordset-Spaltennummern basieren auf 0, was bedeutet, dass die erste Spaltennummer 0 ist, die zweite Spalte 1 und so weiter.

MS-Access Recordset und Klassenmodul

Einführung.

ClsRecUpdate-Klassenmodul.

Das Testprogramm für ClsUpdate.

Liste aller Links zu diesem Thema.