Αυτό το σεμινάριο θα σας διδάξει πώς να εργάζεστε με τους Πίνακες Πρόσβασης χρησιμοποιώντας VBA.
Πρόσβαση στους πίνακες VBA
Για να ξεκινήσετε, θα δείξουμε τις απλές εντολές για εργασία με τους Πίνακες στην Access. Αργότερα σε αυτό το σεμινάριο θα σας δείξουμε πλήρεις επαγγελματικά ανεπτυγμένες λειτουργίες για εργασία με πίνακες στην Access.
Δημιουργία Πίνακα
Αυτός ο κωδικός θα χρησιμοποιήσει το SQL για να δημιουργήσει έναν πίνακα με το όνομα "Table1" με πεδία "ID" και "Name":
Dim table_name As String Dim πεδία As String table_name = "Table1" πεδία = "([ID] varchar (150), [Name] varchar (150))" CurrentDb. Εκτέλεση "CREATE TABLE" & table_name & πεδία
Κλείσιμο πίνακα
Αυτή η γραμμή κώδικα VBA θα κλείσει έναν πίνακα (αποθήκευση αλλαγών):
DoCmd.Close acTable, "Table1", acSaveYes
Για να κλείσετε έναν πίνακα χωρίς αποθήκευση:
DoCmd.Close acTable, "Table1", acSaveNo
Διαγραφή πίνακα
Αυτός ο κωδικός θα διαγράψει έναν πίνακα (σημείωση: πρώτα ο πίνακας πρέπει να κλείσει):
DoCmd.Close acTable, "Table1", acSaveYes DoCmd.DeleteObject acTable = acDefault, "Table1"
Μετονομασία πίνακα:
Αυτή η γραμμή κώδικα θα μετονομάσει έναν πίνακα πρόσβασης:
DoCmd.Rename "Table1", acTable, "Table1_New"
Μια άλλη επιλογή είναι η χρήση της ιδιότητας TableDefs ενός αντικειμένου βάσης δεδομένων.
Ορισμός tdf = db.TableDefs (strOldTableName) tdf.Name = strNewTableName
Κενός / Διαυγής πίνακας
Αυτός ο κωδικός VBA θα αδειάσει έναν πίνακα:
DoCmd.RunSQL "DELETE * FROM" & "Table1"
Περικοπή πίνακα / Διαγραφή εγγραφών
Αυτή η γραμμή κώδικα VBA χρησιμοποιεί SQL για να διαγράψει εγγραφές από έναν πίνακα που πληρούν ορισμένα κριτήρια:
DoCmd.RunSQL ("DELETE * FROM" & "Table1" & "WHERE" & "num = 2")
Εξαγωγή πίνακα στο Excel
Για να εξάγετε έναν πίνακα στο Excel, χρησιμοποιήστε το DoCmd.OutputTo μέθοδος:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLS, "c: \ temp \ ExportedTable.xls"
ή χρησιμοποιήστε το Φύλλο DoCmd.TransferS spreadsheet μέθοδος:
DoCmd.TransferS spreadsheet acExport, acS spreadsheetTypeExcel9, "Table1", "c: \ temp \ ExportedTable.xls", True
Πίνακας ενημέρωσης
Ο ακόλουθος κώδικας θα ενημερώσει μια εγγραφή, χωρίς να εμφανίζεται το προειδοποιητικό μήνυμα:
DoCmd.SetWarnings (False) DoCmd.RunSQL "Update ProductsT SET ProductsT.ProductName = 'Product AAA' WHERE (((ProductsT.ProductID) = 1))"
Πρόσβαση στις λειτουργίες πίνακα VBA
Τα παραπάνω παραδείγματα κώδικα είναι οι απλές εντολές που μπορείτε να χρησιμοποιήσετε για να αλληλεπιδράσετε με πίνακες χρησιμοποιώντας VBA. Ωστόσο, συχνά θα χρειαστεί να προσθέσετε πολύ περισσότερο υποστηρικτικό κώδικα (συμπεριλαμβανομένου του χειρισμού σφαλμάτων) για να χρησιμοποιήσετε σωστά αυτές τις εντολές. Παρακάτω θα βρείτε επαγγελματικά αναπτυγμένες λειτουργίες για εργασία με Πίνακες στην Access.
Καταμέτρηση εγγραφών πινάκων
Αυτή η συνάρτηση θα μετρήσει τον αριθμό των εγγραφών σε έναν πίνακα:
Public Function Count_Table_Records (TableName As String) As Integer On Error GoTo Err: Dim r As DAO.Recordset Dim c As Integer Set r = CurrentDb.OpenRecordset ("Select count (*) as rcount from" & TableName) .OpenRecordset If (r .EOF) Στη συνέχεια c = 0 Άλλο c = Nz (r! RCount, 0) Τέλος Αν Count_Table_Records = c Έξοδος από τη λειτουργία Err: Καλέστε MsgBox ("Παρουσιάστηκε σφάλμα:" & Err.Description, vbExclamation, "Error") End Function ' Παράδειγμα Χρήσης Ιδιωτικό Υπομέτρημα_Πίνακας_Εγγραφές_Δείγμα () MsgBox (Count_Table_Records ("Table1")) Τέλος υπο
Ελέγξτε αν υπάρχει λειτουργία πίνακα
Αυτή η συνάρτηση θα ελέγξει εάν υπάρχει πίνακας, επιστρέφοντας TRUE ή FALSE:
Δημόσια Λειτουργία TableExists (ByVal strTableName As String) As Boolean 'Function: προσδιορίστε αν υπάρχει πίνακας σε βάση δεδομένων της Access' Επιχειρήματα: strTablename: Όνομα πίνακα για έλεγχο Dim tdf As DAO.TableDef On Error Resume Next set tdf = CurrentDb.TableDefs (strTableName ) TableExists = (Err.Number = 0) End Function
Ακολουθεί ένα παράδειγμα της συνάρτησης που χρησιμοποιείται:
Private Sub TableExists_Example () If VBA_Access_Checks.TableExists ("Table") = True Τότε MsgBox ("Πίνακας βρέθηκε!") Άλλο MsgBox ("Ο πίνακας ΔΕΝ βρέθηκε!") Τέλος Αν Τέλος υπο
Δημιουργία συνάρτησης πίνακα
Αυτή η λειτουργία θα δημιουργήσει έναν πίνακα στην Access VBA στην τρέχουσα βάση δεδομένων:
Public Function CreateTable (table_fields As String, table_name As String) As Boolean Dim strCreateTable As String Dim intCount As Integer Dim strFields () As String Dim strValues () As String Dim strInsertSQL As String Dim intCounter As Integer Dim intData As Integer On Error GoTo Err strFields = Split (table_fields, ",") strCreateTable = "CREATE TABLE" & table_name & "(" For intCounter = 0 To UBound (strFields) - 1 strCreateTable = strCreateTable & "[" & strFields (intCounter) & "] varchar ( 150), "Next If Right (strCreateTable, 1) =", "Στη συνέχεια strCreateTable = Αριστερά (strCreateTable, Len (strCreateTable) - 1) strCreateTable = strCreateTable &") "Τέλος εάν CurrentDb.Εκτέλεση strCreateTable intCounter = 0 intData = 0 Αν Err.Number = 0 Στη συνέχεια CreateTable = True Else CreateTable = False End If Exit Function Err: CreateTable = False MsgBox Err.Number & "" & Err.Description End Function
Αυτή η συνάρτηση θα επιστρέψει TRUE εάν ο πίνακας δημιουργηθεί με επιτυχία ή FALSE εάν ο πίνακας δεν δημιουργηθεί.
Μπορείτε να καλέσετε τη συνάρτηση ως εξής:
Private Sub CreateTable_Example () Call CallTeTable ("f1, f2, f3, f4", "ttest") End Sub
Διαγραφή / λειτουργία πτώσης πίνακα
Αυτή η λειτουργία θα διαγράψει έναν πίνακα εάν υπάρχει:
Public Function DeleteTableIfExists (TableName As String) If Not IsNull (DLookup ("Name", "MSysObjects", "Name = '" & TableName & "" ")) Στη συνέχεια DoCmd.SetWarnings False DoCmd.Close acTable, TableName, acSaveYes DoCmd DeleteObject acTable = acDefault, TableName Debug.Print "Table" & TableName & "deleted…" DoCmd.SetWarnings True End If End Function
Μπορείτε να καλέσετε τη συνάρτηση ως εξής:
Private Sub DeleteTableIfExists_Example () Call DeleteTableIfExists ("Table1") End Sub
Λειτουργία κενού πίνακα
Αυτή η συνάρτηση θα αδειάσει έναν πίνακα εάν υπάρχει:
Public Function EmptyTable (TableName As String) If Not IsNull (DLookup ("Name", "MSysObjects", "Name = '" & TableName & "" ")) Στη συνέχεια DoCmd.SetWarnings False DoCmd.RunSQL" DELETE * FROM "& TableName Debug.Print "Table" & TableName & "κενή …" DoCmd.SetWarnings True End If End Function
Μπορείτε να καλέσετε τη συνάρτηση ως εξής:
Private Sub EmptyTable_Example () Call EmptyTable ("Table1") End Sub
Μετονομασία συνάρτησης πίνακα
Αυτή η συνάρτηση VBA θα μετονομάσει έναν πίνακα:
Public Function RenameTable (ByVal strOldTableName As String, ByVal strNewTableName As String, Optional strDBPath As String) As Boolean Dim db As DAO.Database Dim tdf As TableDef 'Trap για τυχόν σφάλματα. Στο Σφάλμα Συνέχιση Επόμενο 'Εάν το όνομα της βάσης δεδομένων είναι κενό … Εάν Trim $ (strDBPath) = "" Τότε "… στη συνέχεια ρυθμίστε το Db στο τρέχον Db. Ρύθμιση db = CurrentDb () Αλλιώς 'Διαφορετικά, ορίστε το Db στην καθορισμένη ανοιχτή βάση δεδομένων. Ορίστε db = DBEngine.Workspaces (0) .OpenDatabase (strDBPath) 'Δείτε αν προέκυψε σφάλμα. If Err then 'MsgBox "Δεν μπόρεσα να βρω τη βάση δεδομένων για να ανοίξει:" & strDBPath RenameTable = Λειτουργία ψευδούς εξόδου Τέλος Αν τελειώσει Αν Αν ObjectExists ("Table", strOldTableName, strDBPath) Στη συνέχεια, ορίστε tdf = db.TableDefs (strOldTableName) tdf.Name = strNewTableName db.Close RenameTable = True Else RenameTable = Λάθος Λήξη Αν Τέλος Λειτουργίας 'Παράδειγμα Χρήσης Ιδιωτικό Υπο RenameTable_Example () Κλήση RenameTable ("table1", "table2") End Sub
Μπορείτε να καλέσετε τη συνάρτηση ως εξής:
Private Sub RenameTable_Example () Call RenameTable ("table1", "table2") End Sub
Περικοπή / Διαγραφή εγγραφών από τον πίνακα
Αυτή η λειτουργία θα διαγράψει εγγραφές από έναν πίνακα με χειρισμό σφαλμάτων:
Public Function Delete_From_Table (TableName As String, Criteria As String) On Error GoTo SubError DoCmd.SetWarnings False DoCmd.RunSQL ("DELETE * FROM" & TableName & "WHERE" & Criteria) DoCmd.SetWarning: Σφάλμα Delete_From_Table: "& vbCrLf & Err.Number &": "& Err.Description Resume SubExit Τέλος Λειτουργίας 'Χρήση Παράδειγμα Δημόσια Υποδιαγραφή Delete_From_Table_Example () Call Delete_From_Table (" Table1 "," num = 2 ") End Sub
Εξαγωγή πίνακα στο Excel
Αυτή η γραμμή κώδικα θα εξάγει έναν πίνακα στο Excel (νέο υπολογιστικό φύλλο):
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLS, "c: \ temp \ ExportedTable.xls"
Or μπορείτε να χρησιμοποιήσετε αυτήν τη λειτουργία:
Δημόσια Λειτουργία Export_Table_Excel (TableName As String, FilePath As String) DoCmd.TransferS spreadsheet acExport, acS spreadsheetTypeExcel9, TableName, FilePath, True End Function 'Usage Παράδειγμα Sub Export_Table_Excel_Example () Export_Table_Eablex: " Τέλος υπο
Ο παραπάνω κώδικας θα εξαχθεί σε νέο υπολογιστικό φύλλο. Αντ 'αυτού, μπορείτε να προσθέσετε έναν πίνακα σε ένα υπάρχον υπολογιστικό φύλλο. Το άρθρο μας σχετικά με την εισαγωγή / εξαγωγή στην Access VBA καλύπτει αυτό με περισσότερες λεπτομέρειες.
Προσθήκη / προσθήκη εγγραφών σε έναν πίνακα
Αυτή η λειτουργία θα προσθέσει / προσθέσει μια εγγραφή σε έναν πίνακα:
Public Function Append_Record_To_Table (TableName As String, FieldName As String, FieldValue As String) On Error GoTo SubError Dim rs As DAO.Recordset Dim SQL As String Dim CurrentYear As Integer Set rs = CurrentDb.OpenRecordset (TableNameNars) .Value = FieldValue rs.Update rs.Close Set rs = Nothing SubExit: Exit Function SubError: MsgBox "Σφάλμα RunSQL:" & vbCrLf & Err.Number & ":" & Err.Description Resume SubExit End Function 'Usage Παράδειγμα Ιδιωτικό_Προσθήκη_Προσθήκη () Call Append_Record_To_Table ("Table1", "num", 3) End Sub
Προσθήκη εγγραφής στον πίνακα από τη φόρμα
Αυτή η συνάρτηση θα προσθέσει μια εγγραφή σε έναν πίνακα από μια φόρμα:
Δημόσια Λειτουργία Add_Record_To_Table_From_Form (TableName As String) On Error GoTo SubError Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset (TableName) rs.AddNew 'rs! [Field1] = Value1' rs! [Field2] = rs! Field3] = Value3 rs.Update rs.Close Set rs = Nothing SubExit: Exit Function SubError: MsgBox "Refresh_Form error:" & vbCrLf & Err.Number & ":" & Err.Description End Function
