FlexGrid & Database problem

[koustav1985]

Hello everyone,
I was just trying to save data from a FlexGrid to a MS Access database (learned form VBForum), it's a basic one for learning purpose.
The database contains only one table with following 04 columns -
num, docName, docAddr & phNo.

here is the code -

Private Type doctor
 dName As String
 dNo As Integer
 dAddress As String
 pNo As Integer
End Type
Dim d(10) As doctor
Dim i, j, response As Integer

Public con As ADODB.Connection
Public rs As ADODB.Recordset


Private Sub cmdDB_Click()

Dim iRows As Integer
Dim iCols As Integer


Set con = New ADODB.Connection
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data.mdb;Persist Security Info=False"
con.CursorLocation = adUseClient
Set rs = New ADODB.Recordset

rs.Open "select * from doc", con, adOpenDynamic, adLockPessimistic, adCmdText


While rs.EOF = True

With fg
For i = 0 To fg.Rows - 1
rs.AddNew
rs.Fields(num) = fg.TextMatrix(i + 1, 0)
rs.Fields(docName) = fg.TextMatrix(i + 1, 1)
rs.Fields(docAddr) = fg.TextMatrix(i + 1, 2)
rs.Fields(phNo) = fg.TextMatrix(i + 1, 3)
rs.Update
'rs.MoveNext
Next i

End With
Wend




End Sub

Private Sub cmdDisplay_Click()
fg.Rows = fg.Rows + 1
For j = 1 To i
fg.Row = j
fg.Col = 0
fg.Text = d(j - 1).dNo
fg.Col = 1
fg.Text = d(j - 1).dName
fg.Col = 2
fg.Text = d(j - 1).dAddress
fg.Col = 3
fg.Text = d(j - 1).pNo
Next j

response = MsgBox("Want to enter more data?", 1, App.Title)

If (response = 1) Then
  cmdDisplay.Enabled = False
  cmdInput.Enabled = True
  
Else
  cmdDisplay.Enabled = False
  cmdDB.Enabled = True
End If

End Sub

Private Sub cmdInput_Click()
d(i).dNo = InputBox("doctor's no")
d(i).dName = InputBox("doctor's Name")
d(i).dAddress = InputBox("doctor's Address")
d(i).pNo = InputBox("doctor's Contact no")
i = i + 1

cmdInput.Enabled = False
cmdDisplay.Enabled = True


End Sub

Private Sub Form_Load()
fg.Cols = 4
fg.Row = 0
fg.Col = 0
fg.Text = "Doctor's N0."

fg.Col = 1
fg.Text = "Doctor's Name"

fg.Col = 2
fg.Text = "Doctor's Address"

fg.Col = 3
fg.Text = "Contact No."

fg.ColWidth(0) = 1000
fg.ColWidth(1) = 1200
fg.ColWidth(2) = 1500
fg.ColWidth(3) = 1200


cmdDisplay.Enabled = False
cmdDB.Enabled = False



End Sub

I'm getting error - "Run-Time error '3265' Item cannot be found in the collection corresponding
to the requested name or ordinal"

Tried a lot but can't find the error.
Please help.
A lot of thanks in advance

[Arnoutdv]

On which line do you get that error?

[koustav1985]

at
rs.Fields(num) = fg.TextMatrix(i + 1, 0)

[Arnoutdv]

rs.Fields(num) = fg.TextMatrix(i + 1, 0)
rs.Fields(docName) = fg.TextMatrix(i + 1, 1)
rs.Fields(docAddr) = fg.TextMatrix(i + 1, 2)
rs.Fields(phNo) = fg.TextMatrix(i + 1, 3)

Where are those red variables declared?
What are the supposed values?

[techgnome]

rs.Fields(num) = fg.TextMatrix(i + 1, 0)
rs.Fields(docName) = fg.TextMatrix(i + 1, 1)
rs.Fields(docAddr) = fg.TextMatrix(i + 1, 2)
rs.Fields(phNo) = fg.TextMatrix(i + 1, 3)

Where are those red variables declared?
What are the supposed values?

The database contains only one table with following 04 columns -
num, docName, docAddr & phNo.

They look like the field names. They should be in quotes, not used as variables.

rs.Fields("num") = fg.TextMatrix(i + 1, 0)
rs.Fields("docName") = fg.TextMatrix(i + 1, 1)
rs.Fields("docAddr") = fg.TextMatrix(i + 1, 2)
rs.Fields("phNo") = fg.TextMatrix(i + 1, 3)

Since a build error wasn't thrown, I'm guessing Option Explicit is turned off, which isn't a good thing.

-tg

[Schmidt]

I was just trying to save data from a FlexGrid to a MS Access database -
(learned form VBForum), it's a basic one for learning purpose.

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"):

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)

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):

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:


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

[koustav1985]

Wow, great. Thanks a lot everyone for your valuable guidance. I'll try these for sure.

In between, I was trying my old code.
I've included the "" at rs.Fields("").
Now the data are being stored at the DB BUT following error is shown-
Multiple-step operation generated errors. Check is status value.
just after rs.addnew

[softv]

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"):

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)

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):

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:


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

Dear Olaf,

I realised today, just a while ago, that I have not thanked you yet for your magic above!

I have been using your 'BindTo' magic in my recent project and its all magic indeed. Working so so beautifully, fluently and fastly. Thanks a TONNNN, as always.

Kind Regards.