If it's for learning-purposes, then I'd start out with better tools, as e.g.:
- Krools VbFlexGrid instead of the MS-FlexGrid (which is an editable FlexGrid, that supports "virtual Bindings")
- SQLite instead of MS-Access (MS-JET) *.mdbs
This way you will end up with *far* less code for such "CRUD"-scenarios
(CRUD meaning "full editability of your DB-Data"-> Create, Read, Update, Delete)
I've made a little example out of your Doctors-Tabe, which does the following:
- it creates the DB(File) at App-Startup (if it does not exist yet in your App.Path)
- it creates the Doctors-Table at App-Startup (if it does not yet exist)
The code which ensures the above two points is the following
(placed in a modMain.bas - the
Project-Settings need to be switched to "Start from Sub Main"):
Code:
Option Explicit
Public DBFile As String, Cnn As cConnection
Sub Main()
DBFile = App.Path & "\Test.db3" 'define the DB-Filename
'create a new DB, if the File does not exists, otherwise just open the existing DB
Set Cnn = New_c.Connection(DBFile, IIf(New_c.FSO.FileExists(DBFile), DBOpenFromFile, DBCreateNewFileDB))
'create a new Doctors-Table if it is not yet in the DB, otherwise do nothing (ensured by the "If Not Exists"-part)
Cnn.Execute "Create Table If Not Exists Doctors(ID Integer Primary Key, Name Text, Email Text, Phone Text)"
Form1.Show 'finally show the Main-Form of the App
End Sub
And to ensure that your Doctors-Table is rendered in an editable Grid, you need:
- a Project-Reference to vbRichClient5 (or alternatively RC6) - both downloadable from vbRichClient.com
- a Component-Reference to VBFlexGrid 1.4 (downloadable here:
https://www.vbforums.com/showthread....25#post5236525
Now place a new VBFlexGrid-instance on your Form1 and
name it FG: (then paste the following code into the Form)
Code:
Option Explicit
Private DS As New cFlexSQLiteDS 'define the binding DataSource-Object
Private Sub Form_Load()
FG.Font.Name = "Arial"
DS.BindTo FG, Cnn.OpenRecordset("Select * From Doctors"), True, True 'here is, where the Rs is bound to the Grid
End Sub
'the rest is generic Support for the DS, via Events which were triggered from the 'FG' (our VBFlexGrid-instance)
Private Sub FG_SelChange()
DS.SyncRsPos FG.Row
End Sub
Private Sub FG_LeaveEdit()
DS.SaveChangesOn FG
FG.AutoSize FG.Col '<- this line is optional... (AutoSizing, in case the new cell-entry is larger than the current Col-Width)
End Sub
Private Sub FG_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then DS.DeleteRowOn FG
End Sub
Private Sub FG_BeforeMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single, Cancel As Boolean)
If FG.MouseRow = 0 Then Cancel = True: FG.CancelEdit: DS.ColSortOn FG, Button = 2
End Sub
As you can see, the code-volume up to this point is quite sparse (for a fully editable "CRUD-Grid").
The "magic" which allows that, is happening in the blue marked line of the Form-Code above.
Which brings us to the Binding-Class which provides that magic -
(the 3rd and last Code-Module of our CRUD-App - a Class,
named cFlexSQLiteDS):
Code:
Option Explicit 'a generic Helper-Class, which implements IVBFlexDataSource (bound to an RC5/6-SQLite-Rs)
'for this Binding to work properly, the Selects should include the PK-Field in the first Column, named as "ID"
Implements IVBFlexDataSource
Public Rs As cRecordset
Private mAllowAddNew As Boolean
Public Sub BindTo(FG As VBFlexGrid, Rs As cRecordset, Optional ByVal AllowEdit As Boolean, Optional ByVal AllowAddNew As Boolean)
Set Me.Rs = Rs
mAllowAddNew = AllowAddNew
If mAllowAddNew Then Rs.AddNew 'add one more Row to the Rs (to cover the handling of potential new Records)
Set FG.FlexDataSource = Me 'bind this DataSource to the FlexGrid-instance (to visualize the Recordset-Data)
FG.AllowUserEditing = AllowEdit And Rs.RecordCount > 0
FG.Rows = Rs.RecordCount + 1
FG.SelectionMode = FlexSelectionModeFreeByRow
FG.RowHeight(0) = FG.TextHeight("") * 1.75
FG.BorderStyle = FlexBorderStyleSingle
FG.AutoSize 0, FG.Cols - 1
If FG.Row > 0 And FG.Row < Rs.RecordCount Then Rs.AbsolutePosition = FG.Row
If UCase(Rs.Fields(0).Name) = "ID" Then FG.FixedCols = 1
End Sub
Public Property Get ID()
If Rs.RecordCount Then ID = Rs(0).Value
End Property
Public Property Get AllowAddNew() As Boolean
AllowAddNew = mAllowAddNew
End Property
Public Function SyncRsPos(ByVal fgRow As Long) As Boolean 'returns True only, when a matching Rs-Row existed
If Rs.RecordCount = 0 Or fgRow < 1 Or fgRow > Rs.RecordCount Then Exit Function
Rs.AbsolutePosition = fgRow 'synchronize the RecordPointer of the Parent-Recordset to the Grid-Row
SyncRsPos = True
End Function
Public Sub ColSortOn(FG As VBFlexGrid, ByVal RemoveSorting As Boolean)
Dim A&: A& = InStr(Rs.Sort, " Asc")
Dim ID: ID = Me.ID
Rs.ReQuery
Rs.Sort = IIf(RemoveSorting, "", Rs(FG.MouseCol).Name & IIf(A, " Desc", " Asc"))
BindTo FG, Rs, FG.AllowUserEditing, mAllowAddNew
If Not IsEmpty(ID) Then If Rs.FindFirst("ID=" & ID) Then FG.Row = Rs.AbsolutePosition
FG.Col = IIf(FG.MouseCol > 0, FG.MouseCol, 1)
FG.CellEnsureVisible FlexVisibilityCompleteOnly
End Sub
Public Function DeleteRowOn(FG As VBFlexGrid) As Boolean
If Rs.RecordCount = 0 Or FG.Row < 1 Or FG.Row > Rs.RecordCount Or (mAllowAddNew And FG.Row = Rs.RecordCount) Then Exit Function
Rs.AbsolutePosition = FG.Row
Rs.Delete
SaveChangesOn FG
DeleteRowOn = True
End Function
Public Sub SaveChangesOn(FG As VBFlexGrid)
Dim Fld As cField, Dirty As Boolean, APos As Long, Row As Long, Col As Long, Sort$, ID
ID = Me.ID
If mAllowAddNew And Rs.RecordCount > 0 Then
If Rs.RecordCount Then APos = Rs.AbsolutePosition: Rs.MoveLast
For Each Fld In Rs.Fields
If Not (UCase(Fld.Name) = "ID" Or UCase(Right(Fld.Name, 3)) = "_ID" Or IsEmpty(Fld.Value)) Then Dirty = True
Next
If Not Dirty Then Rs.Delete 'remove a priorily added "new-record-entry" (in case it was not used)
End If
Rs.UpdateBatch 'save the Rs-changes to the DB
If IsEmpty(ID) Then ID = Rs.ActiveConnection.LastInsertAutoID
Sort = Rs.Sort: Rs.ReQuery: Rs.Sort = Sort 'Requery (restoring previous sort-settings)
If Not IsEmpty(ID) Then Rs.FindFirst ("ID=" & ID): APos = Rs.AbsolutePosition
Row = IIf(APos > 0, APos, FG.Row): Col = FG.Col
BindTo FG, Rs, FG.AllowUserEditing, mAllowAddNew
FG.Row = Row: FG.Col = Col
End Sub
'*** Ok, finally the 5 Implementation of IVBFlexDataSource
Private Function IVBFlexDataSource_GetFieldCount() As Long
IVBFlexDataSource_GetFieldCount = Rs.Fields.Count
End Function
Private Function IVBFlexDataSource_GetFieldName(ByVal Field As Long) As String
Dim S$: If InStr(Rs.Sort, Rs(Field).Name & " ") Then S = ChrW(IIf(InStr(Rs.Sort, "Desc"), 9660, 9650))
IVBFlexDataSource_GetFieldName = " " & Rs(Field).Name & " " & S
End Function
Private Function IVBFlexDataSource_GetRecordCount() As Long
IVBFlexDataSource_GetRecordCount = Rs.RecordCount
End Function
Private Function IVBFlexDataSource_GetData(ByVal Field As Long, ByVal Record As Long) As String
If Record < Rs.RecordCount Then IVBFlexDataSource_GetData = Rs.ValueMatrix(Record, Field) Else Exit Function
If Len(IVBFlexDataSource_GetData) = 0 And Field = 0 Then IVBFlexDataSource_GetData = "New..."
End Function
Private Sub IVBFlexDataSource_SetData(ByVal Field As Long, ByVal Record As Long, ByVal NewData As String)
If Record < Rs.RecordCount Then Rs.ValueMatrix(Record, Field) = NewData
End Sub
Here is, what these 3 Code-Modules will produce:
https://www.vbforums.com/images/ieimages/2021/03/2.png
Forgot to mention, that this Demo-Code:
- already supports sorting when you click the Column-headers (right MouseClick removes Sorting)
- the "D" in CRUD is ensured via the Delete-Key (which deletes the currently selected Row)
- there is no "do you want to really save this" Popups currently, every change is written immediately into the DB
HTH
Olaf
