MS-Access Recordset og klassemodul

Introduktion.

Her vil vi bygge et klassemodul til databehandlingsopgaver, et DAO.Recordset Objektet vil blive videregivet til det brugerdefinerede klasseobjekt. Da det er et objekt, der overføres til vores brugerdefinerede klasse, har vi brug for sættet og Hent Egenskabsprocedurepar for at tildele og hente objektet eller dets egenskabsværdier.

Vi har en lille tabel:Tabel1 , med få poster i det. Her er billedet af tabel 1.

Ovenstående tabel har kun fire felter:Desc, Qty, UnitPrice og TotalPrice. Feltet Totalpris er tomt.

En af opgaverne i vores klassemodul er at opdatere feltet TotalPrice med produktet af Antal * Enhedspris.
Klassemodulet har en underrutine til at sortere dataene i det brugerspecificerede felt og dumper en liste i fejlfindingsvinduet.
En anden underrutine opretter en kopi af tabellen med et nyt navn efter sortering af data baseret på kolonnenummeret angivet som en parameter.

ClsRecUpdate klassemodul.

Åbn din Access-database, og åbn VBA-vinduet.
Indsæt et klassemodul.
Skift dens navneegenskabsværdi til ClsRecUpdate .

Kopiér og indsæt følgende kode i klassemodulet, og gem modulet:

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

Egenskaben rstB er erklæret som et DAO.Recordset Object.

Gennem sæt egenskabsproceduren kan et postsætobjekt sendes til klassen ClsRecUpdate Objekt.

Update() Subrutine accepterer numre med tre kolonner (0-baserede kolonnenumre) som parametre for at beregne og opdatere den tredje parameterkolonne med produktet af den første kolonne * anden kolonne.

DataSort() subrutine Sorterer posterne i stigende rækkefølge baseret på kolonnenummeret, der er sendt som parameter.

Sorteringskolonnens datatype skal være nummer eller valuta eller streng. Andre datatyper ignoreres.

En liste over posterne vil blive dumpet i fejlfindingsvinduet. Listen over felter vil kun være begrænset til fem felter, hvis registreringskilden har mere end det, ignoreres resten af felterne.

TblCreate() subrutine vil sortere data, baseret på kolonnenummeret, der er sendt som en parameter, og opretter en tabel med et nyt navn. Parameteren er valgfri, hvis et kolonnenummer ikke videregives som en parameter, vil tabellen blive sorteret efter data i den første kolonne, hvis kolonnens datatype er en gyldig type. Det oprindelige navn på tabellen vil blive ændret og tilføjet med strengen “_2” til det oprindelige navn. Hvis kildetabelnavnet er Tabel1 så vil det nye tabelnavn være Tabel1_2 .

Testprogrammet til ClsUpdate.

Lad os teste ClsRecUpdate Klasseobjekt med et lille program.

Testprogramkoden er angivet nedenfor:

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

Du kan bestå ethvert postsæt for at teste klasseobjektet.

Du kan videregive alle kolonnenumre for at opdatere en bestemt kolonne. Kolonnenumrene er ikke nødvendigvis fortløbende numre. Men den tredje kolonnenummerparameter er målkolonnen, der skal opdateres. Den første parameter ganges med den anden kolonneparameter for at nå frem til den resultatværdi, der skal opdateres. Du kan ændre klassemodulkoden til at udføre enhver anden handling, du ønsker at udføre på bordet.

Valg af sorteringskolonnedatatype skal kun være streng, numerisk eller valutatype. Andre typer ignoreres. Recordset kolonnenumre er 0-baserede, hvilket betyder, at det første kolonnenummer er 0, den anden kolonne er 1, og så videre.

MS-Access Recordset og klassemodul

Introduktion.

ClsRecUpdate klassemodul.

Testprogrammet til ClsUpdate.

Liste over alle links om dette emne.