Access
 sql >> Database >  >> RDS >> Access

Recordset MS-Access e modulo di classe

Introduzione.

Qui creeremo un modulo di classe per le attività di elaborazione dei dati, un DAO.Recordset L'oggetto verrà passato all'oggetto classe personalizzata. Poiché è un Oggetto che sta passando alla nostra Classe Personalizzata, abbiamo bisogno del Set e Ottieni Proprietà Coppia di procedure per assegnare e recuperare l'Oggetto oi suoi valori di Proprietà.

Abbiamo una piccola tabella:Tabella1 , con pochi record al suo interno. Ecco l'immagine di Table1.

La tabella sopra ha solo quattro campi:Desc, Qty, UnitPrice e TotalPrice. Il campo PrezzoTotale è vuoto.

  • Uno dei compiti del nostro modulo di classe è aggiornare il campo TotalPrice con il prodotto di Qty * UnitPrice.
  • Il modulo di classe ha una subroutine per ordinare i dati, nel campo specificato dall'utente, e scarica un elenco nella finestra di debug.
  • Un'altra subroutine crea una copia della Tabella con un nuovo nome, dopo aver ordinato i dati in base al numero di colonna fornito come parametro.

Modulo di classe ClsRecUpdate.

  1. Apri il tuo database di Access e apri la finestra VBA.
  2. Inserisci un modulo di classe.
  3. Modifica il valore della proprietà del nome in ClsRecUpdate .
  4. Copia e incolla il codice seguente nel modulo di classe e salva il modulo:
    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

La proprietà rstB è dichiarata come oggetto DAO.Recordset.

Tramite la procedura Set Property, un oggetto recordset può essere passato alla classe ClsRecUpdate Oggetto.

L'Aggiorna() La subroutine accetta numeri a tre colonne (numeri di colonna basati su 0) come parametri per calcolare e aggiornare la terza colonna di parametro con il prodotto della prima colonna * seconda colonna.

Il DataSort() subroutine Ordina i record in ordine crescente in base al numero di colonna passato come parametro.

Il tipo di dati Colonna di ordinamento deve essere Numero o Valuta o Stringa. Gli altri tipi di dati vengono ignorati.

Un elenco dei record verrà scaricato nella finestra di debug. L'elenco dei campi sarà limitato a cinque soli campi, se l'origine del record ne contiene più, il resto dei campi verrà ignorato.

Il TblCreate() la subroutine Ordina i dati, in base al numero di colonna passato come parametro, e crea una tabella con un nuovo nome. Il parametro è facoltativo, se un numero di colonna non viene passato come parametro, la tabella verrà ordinata in base ai dati nella prima colonna se il tipo di dati della colonna è un tipo valido. Il nome originale della tabella verrà modificato e aggiunto con la stringa “_2” al nome originale. Se il nome della tabella di origine è Table1 quindi il nuovo nome della tabella sarà Table1_2 .

Il programma di test per ClsUpdate.

Proviamo il ClsRecUpdate Oggetto di classe con un piccolo programma.

Il codice del programma di test è riportato di seguito:

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

Puoi passare qualsiasi recordset per testare l'oggetto classe.

Puoi passare qualsiasi numero di colonna per aggiornare una determinata colonna. I numeri delle colonne non sono necessariamente numeri consecutivi. Tuttavia, il terzo parametro del numero di colonna è la colonna di destinazione da aggiornare. Il primo parametro viene moltiplicato per il secondo parametro di colonna per arrivare al valore del risultato da aggiornare. Puoi modificare il codice del modulo di classe per eseguire qualsiasi altra operazione che desideri fare sul tavolo.

La selezione del tipo di dati della colonna di ordinamento deve essere solo di tipo Stringa, Numerico o Valuta. Gli altri tipi vengono ignorati. I numeri di colonna del recordset sono basati su 0, il che significa che il numero della prima colonna è 0, la seconda colonna è 1 e così via.

Elenco di tutti i collegamenti su questo argomento.

  1. Modulo di classe MS-Access e VBA
  2. Matrici di oggetti di classe VBA MS-Access
  3. Classe base MS-Access e oggetti derivati
  4. Classe base VBA e oggetti derivati-2
  5. Classe base e varianti di oggetti derivati
  6. Recordset Ms-Access e modulo di classe
  7. Accedi al modulo di classe e alle classi wrapper
  8. Trasformazione della funzionalità della classe wrapper
  9. Nozioni di base su Ms-Access e Collection Object
  10. Modulo di classe Ms-Access e oggetto Collection
  11. Record di tabella nell'oggetto e nella forma della raccolta
  12. Nozioni di base sugli oggetti del dizionario
  13. Nozioni di base sugli oggetti del dizionario-2
  14. Ordinamento delle chiavi e degli elementi degli oggetti del dizionario
  15. Visualizza record dal dizionario al modulo
  16. Aggiungi oggetti classe come elementi del dizionario
  17. Aggiorna l'elemento del dizionario degli oggetti della classe nel modulo