Recordset MS-Access dan Modul Kelas

Pengantar.

Di sini, kita akan membangun Modul Kelas untuk tugas pemrosesan data, sebuah DAO.Recordset Objek akan diteruskan ke Objek Kelas Kustom. Karena ini adalah Objek yang diteruskan ke Kelas Kustom kami, kami memerlukan Set dan Dapatkan Pasangan Prosedur Properti untuk menetapkan dan mengambil Objek atau nilai Propertinya.

Kami memiliki Tabel kecil:Tabel1 , dengan sedikit catatan di dalamnya. Berikut adalah gambar Tabel1.

Tabel di atas hanya memiliki empat bidang:Desc, Qty, UnitPrice, dan TotalPrice. Kolom TotalPrice kosong.

Salah satu tugas Modul Kelas kami adalah memperbarui bidang TotalPrice dengan produk Qty * UnitPrice.
Modul Kelas memiliki subrutin untuk mengurutkan data, di bidang yang ditentukan pengguna, dan membuang daftar di Jendela Debug.
Subrutin lain membuat salinan Tabel dengan nama baru, setelah mengurutkan data berdasarkan nomor kolom yang disediakan sebagai parameter.

Modul Kelas ClsRecUpdate.

Buka Access Database Anda dan buka Jendela VBA.
Menyisipkan Modul Kelas.
Ubah Nama Nilai Propertinya menjadi ClsRecUpdate .

Salin dan Tempel Kode berikut ke dalam Modul Kelas dan simpan 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

Properti rstB dideklarasikan sebagai Objek DAO.Recordset.

Melalui Prosedur Set Properti, objek recordset dapat diteruskan ke Kelas ClsRecUpdate Objek.

Pembaruan() Subrutin menerima nomor tiga kolom (nomor kolom berdasarkan 0) sebagai parameter untuk menghitung dan memperbarui kolom parameter ketiga dengan produk dari kolom pertama * kolom kedua.

DataSort() subrutin Mengurutkan record dalam urutan menaik berdasarkan Nomor Kolom yang diteruskan sebagai parameter.

Tipe data Sorting Column harus Number atau Currency atau String. Tipe data lainnya diabaikan.

Daftar catatan akan dibuang di Jendela Debug. Daftar kolom akan dibatasi hingga lima kolom saja, jika sumber rekaman memiliki lebih dari itu, maka kolom lainnya akan diabaikan.

TblCreate() subrutin akan Mengurutkan data, berdasarkan nomor kolom yang dilewatkan sebagai parameter, dan membuat Tabel dengan nama baru. Parameter adalah opsional, jika nomor kolom tidak dilewatkan sebagai parameter maka Tabel akan diurutkan pada data di kolom pertama jika tipe data kolom adalah tipe yang valid. Nama asli Tabel akan diubah dan ditambahkan dengan String “_2” ke nama aslinya. Jika nama Tabel Sumber adalah Tabel1 maka nama tabel baru akan menjadi Table1_2 .

Program Tes untuk ClsUpdate.

Mari kita uji ClsRecUpdate Kelas Objek dengan Program kecil.

Kode program pengujian diberikan di bawah ini:

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

Anda dapat melewati recordset apa pun untuk menguji Objek Kelas.

Anda dapat memberikan nomor kolom apa pun untuk memperbarui kolom tertentu. Nomor kolom tidak harus nomor berurutan. Tapi, parameter nomor kolom ketiga adalah kolom target untuk diperbarui. Parameter pertama dikalikan dengan parameter kolom kedua untuk sampai pada nilai hasil yang akan diperbarui. Anda dapat memodifikasi kode Modul Kelas untuk melakukan operasi lain yang ingin Anda lakukan pada tabel.

Pemilihan tipe data Sortir Kolom harus String, Numerik, atau Tipe Mata Uang saja. Jenis lain diabaikan. Nomor kolom Recordset berbasis 0, yang berarti nomor kolom pertama adalah 0, kolom kedua adalah 1, dan seterusnya.

Daftar Semua Tautan pada Topik ini.

Modul Kelas MS-Access dan VBA
Array Objek Kelas VBA MS-Access
Kelas Dasar MS-Access dan Objek Turunannya
Kelas Dasar VBA dan Objek Turunan-2
Varian Kelas Dasar dan Objek Turunan
Set Rekaman Ms-Access dan Modul Kelas
Mengakses Modul Kelas dan Kelas Pembungkus
Transformasi Fungsionalitas Kelas Wrapper
Dasar-dasar Ms-Access dan Objek Koleksi
Modul Kelas Ms-Access dan Objek Koleksi
Rekaman Tabel dalam Objek dan Formulir Koleksi
Dasar-dasar Objek Kamus
Dasar-Dasar Objek Kamus-2
Mengurutkan Kunci Objek dan Item Kamus
Menampilkan Rekaman dari Kamus ke Formulir
Menambahkan Objek Kelas sebagai Item Kamus
Memperbarui Item Kamus Objek Kelas pada Formulir