writing from a flexgrid to a database

[Niamh02]

Im populating a flexgrid in my vb project from a ms access 2000 database. I want the user to be able to edit some fields in the flexgrid. Is it possible to save these changes back to the database, if so - how do I do this?
Thanking you in advance
Niamh

 

[zemp]

Unfortunatly there is no direct way to enter or edit values into a flex grid. However you can make the user think that that is what they are doing.

You will be using a floating text box that you position to look like a cell of the grid and enter values into the text box and then copy those values into the grid.

Below is the code from a form that does that. The important areas are the grids enter cell event and the floating text boxes keyup event. I have the data in an array for flexibility. Don't worry about the names. The ADO code is for SQL server 2000 database.

Option Explicit

Private m_bolIsDirty As Boolean
Private m_bolSkipIt As Boolean
Private m_intSelected As Integer
Private m_bolNewTicket As Boolean

Private Sub cmdAdd_Click()
'// Adds a new row into the grid and adds a new element to the udt.
On Error GoTo ERR_AddTicketStatus

m_bolNewTicket = True
m_bolSkipIt = True
msfgTicketStatus.Rows = msfgTicketStatus.Rows + 1
msfgTicketStatus.Row = msfgTicketStatus.Rows - 1
msfgTicketStatus.Col = 1
msfgTicketStatus.Text = "No"
msfgTicketStatus.Col = 0
ReDim Preserve g_udtTicketStatus(UBound(g_udtTicketStatus) + 1) As tdOption
m_bolSkipIt = False
Exit Sub

ERR_AddTicketStatus:
m_bolSkipIt = False
If Err.Number = 9 Then '// Subscript out of range, no elements in array.
ReDim g_udtTicketStatus(0) As tdOption
Else
ErrorMessenger Err.Number, Err.Description, "frmTicketStatus.cmdAdd.Click", "Ticket Status Error"
End If
End Sub

Private Sub cmdClose_Click()
'// Return to the order entry form.
Unload frmTicketStatus
End Sub

Private Sub cmdDelete_Click()
'// Delete a unit of measure from ther database and refill the grid.
Delete_TicketStatus
Get_TicketStatus
Fill_FlexGrid
m_bolIsDirty = False
cmdDelete.Enabled = False
End Sub

Private Sub cmdReset_Click()
'// Resets all the defaults values to 'No'.
Dim l_intCount As Integer

For l_intCount = 0 To UBound(g_udtTicketStatus)
If g_udtTicketStatus(l_intCount).DefaultOpt = 1 Then
g_udtTicketStatus(l_intCount).DefaultOpt = 0
m_intSelected = l_intCount
m_bolIsDirty = True
Update_TicketStatus
End If
Next l_intCount
Fill_FlexGrid
cmdSave.Enabled = True
End Sub

Private Sub cmdSave_Click()
'// Save any new or changed information.
SaveInfo_TicketStatus
End Sub

Private Sub Form_Load()
'// Set up the form.
frmTicketStatus.Caption = App.Title & " - Ticket Status"
frmTicketStatus.Icon = LoadResPicture(101, vbResIcon)
m_bolSkipIt = True

Get_TicketStatus
Fill_FlexGrid

m_bolSkipIt = False
cmdSave.Enabled = False
cmdDelete.Enabled = False
m_intSelected = -1
m_bolIsDirty = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'// Save any changes and then close the form.
If m_bolIsDirty Then SaveInfo_TicketStatus
g_intFromForm = eTicketStatus
End Sub

Private Sub msfgTicketStatus_EnterCell()
'// Set up the floating text box.
If m_bolSkipIt Then Exit Sub
'// Check to save info if the user changes rows.
If m_intSelected <> msfgTicketStatus.Row - 1 And m_intSelected <> -1 Then
If m_bolIsDirty Then SaveInfo_TicketStatus
End If
txtFloat.Text = msfgTicketStatus.Text
Position_TextBox
m_intSelected = msfgTicketStatus.Row - 1
If msfgTicketStatus.Col = 1 Then
txtFloat.Locked = True
Else
txtFloat.Locked = False
End If
cmdDelete.Enabled = True
End Sub

Private Sub txtFloat_Click()
'// Used to set the defaults.
Dim l_intCount As Integer

If msfgTicketStatus.Col = 1 Then
For l_intCount = 0 To UBound(g_udtTicketStatus)
If g_udtTicketStatus(l_intCount).DefaultOpt = 1 Then
g_udtTicketStatus(l_intCount).DefaultOpt = 0
m_intSelected = l_intCount
Update_TicketStatus
End If
Next l_intCount
g_udtTicketStatus(msfgTicketStatus.Row - 1).DefaultOpt = 1
m_intSelected = msfgTicketStatus.Row - 1
Update_TicketStatus
Fill_FlexGrid
cmdSave.Enabled = True
End If
End Sub

Private Sub txtFloat_KeyUp(KeyCode As Integer, Shift As Integer)
'// Assign the value in the text box to the correct grid.
Dim l_intRow As Integer
On Error GoTo ERR_Key

Select Case KeyCode
Case vbKeyRight '// Move one column right.
msfgTicketStatus.Col = msfgTicketStatus.Col + 1 Mod msfgTicketStatus.Cols
txtFloat.SelStart = 0
txtFloat.SelLength = Len(txtFloat.Text)
Case vbKeyLeft '// Move one column left
msfgTicketStatus.Col = msfgTicketStatus.Col - 1 Mod msfgTicketStatus.Cols
txtFloat.SelStart = 0
txtFloat.SelLength = Len(txtFloat.Text)
Case Else '// Entering values.
msfgTicketStatus.Text = Trim(txtFloat.Text)
l_intRow = msfgTicketStatus.Row
Select Case msfgTicketStatus.Col
Case 0
g_udtTicketStatus(l_intRow - 1).NameOpt = Trim(txtFloat.Text)
Case 2
g_udtTicketStatus(l_intRow - 1).Description = Trim(txtFloat.Text)
End Select
m_bolIsDirty = True
cmdSave.Enabled = True
End Select

Exit Sub
ERR_Key:
If Err.Number = 30010 Then
Resume Next
Else
ErrorMessenger Err.Number, Err.Description, &quot;frmTicketStatus.txtFloat.KeyUp&quot;, &quot;Ticket Status Error&quot;
End If
End Sub

Private Sub Position_TextBox()
'// Postions the floating text box within the cell of the grid.
txtFloat.top = msfgTicketStatus.CellTop + msfgTicketStatus.top
txtFloat.Left = msfgTicketStatus.CellLeft + msfgTicketStatus.Left
txtFloat.width = msfgTicketStatus.CellWidth
txtFloat.Height = msfgTicketStatus.CellHeight
txtFloat.Visible = True
txtFloat.SelStart = 0
txtFloat.SelLength = Len(txtFloat.Text)
txtFloat.SetFocus
End Sub

Private Sub Fill_FlexGrid()
'// Places the data into the flex grid.
Dim l_intRow As Integer

On Error GoTo ERR_FillGrid

m_bolSkipIt = True
txtFloat.Visible = False
For l_intRow = 1 To UBound(g_udtTicketStatus) + 1
msfgTicketStatus.Rows = l_intRow + 1
msfgTicketStatus.Row = l_intRow
msfgTicketStatus.Col = 0
msfgTicketStatus.Text = Trim(g_udtTicketStatus(l_intRow - 1).NameOpt)
msfgTicketStatus.Col = 1
If g_udtTicketStatus(l_intRow - 1).DefaultOpt = 1 Then
msfgTicketStatus.Text = &quot;Yes&quot;
Else
msfgTicketStatus.Text = &quot;No&quot;
End If
msfgTicketStatus.Col = 2
msfgTicketStatus.Text = Trim(g_udtTicketStatus(l_intRow - 1).Description)
Next l_intRow
m_bolSkipIt = False
Exit Sub
ERR_FillGrid:

msfgTicketStatus.Rows = 1
m_bolSkipIt = False
If Err.Number <> 9 Then '// Subscript out of range, no values in the database.
ErrorMessenger Err.Number, Err.Description, &quot;frmTicketStatus.Fill_FlexGrid&quot;, &quot;Ticket Status Error&quot;
End If
End Sub

Private Sub AddNew_TicketStatus()
'// Adds a new Ticket Status to the database.
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command

On Error GoTo ERR_AddNewTicketStatus
With cmd
.ActiveConnection = tdCONN
.CommandText = &quot;sprTicketStatus&quot;
.CommandType = adCmdStoredProc
End With
rs.Open cmd, , adOpenStatic, adLockOptimistic
rs.AddNew
With g_udtTicketStatus(m_intSelected)
rs![TSName] = .NameOpt
rs![TSDescription] = .Description
rs![DefaultTS] = .DefaultOpt
End With
rs.Update
rs.Close
m_bolNewTicket = False
Exit Sub

ERR_AddNewTicketStatus:
If Err.Number = 94 Then '// Invalid use of null.
Resume Next
Else
ErrorMessenger Err.Number, Err.Description, &quot;frmTicketStatus.AddNew_TicketStatus&quot;, &quot;Ticket Status Add New Error&quot;
End If
End Sub

Private Sub Update_TicketStatus()
'// Updates or edits the current Ticket Status in the database.
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command

On Error GoTo ERR_UpdateTicketStatus

With cmd
.ActiveConnection = tdCONN
.CommandText = &quot;sprTicketStatusOne&quot;
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter(&quot;TSID&quot;, adTinyInt, adParamInput)
.Parameters(&quot;TSID&quot.value = g_udtTicketStatus(m_intSelected).ID
End With
rs.Open cmd, , adOpenStatic, adLockOptimistic
rs.MoveFirst
With g_udtTicketStatus(m_intSelected)
rs![TSName] = .NameOpt
rs![TSDescription] = .Description
rs![DefaultTS] = .DefaultOpt
End With
rs.Update
rs.Close
Exit Sub

ERR_UpdateTicketStatus:
If Err.Number = 94 Then '// Invalid use of null.
Resume Next
ElseIf Err.Number = 3021 Then '// No current record.
'// Do nothing.
Else
ErrorMessenger Err.Number, Err.Description, &quot;frmTicketStatus.Update_TicketStatus&quot;, &quot;Ticket Status Update Error&quot;
End If
End Sub

Private Sub Delete_TicketStatus()
'// Deletes the selected Ticket status from the database.
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command

On Error GoTo ERR_DeleteTicketStatus
With cmd
.ActiveConnection = tdCONN
.CommandText = &quot;sprTicketStatusOne&quot;
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter(&quot;TSID&quot;, adTinyInt, adParamInput)
.Parameters(&quot;TSID&quot.value = g_udtTicketStatus(m_intSelected).ID
End With
rs.Open cmd, , adOpenStatic, adLockOptimistic
rs.Delete
rs.Close
ContinueHere:
Exit Sub

ERR_DeleteTicketStatus:
If Err.Number = 3021 Then '// No Records in database.
Resume ContinueHere
ElseIf Err.Number = -2147217873 Then '// Foreign key constraint.
MsgBox &quot;You cannot delete this ticket status because&quot; & vbCrLf & _
&quot;it is used by one or more areas in the program.&quot;, vbOKOnly + vbApplicationModal + _
vbExclamation + vbDefaultButton1, &quot;Unable to Delete Ticket Status&quot;
Else
ErrorMessenger Err.Number, Err.Description, &quot;frmTicketStatus.Delete_TicketStatus&quot;, &quot;Ticket Status Delete Error&quot;
End If
End Sub

Private Sub SaveInfo_TicketStatus()
'// Save any new or changed information.
If m_bolNewTicket Then
AddNew_TicketStatus
Else
Update_TicketStatus
End If
m_bolIsDirty = False
End Sub

Thanks and Good Luck!

zemp

 

[Niamh02]

Thanks for all the code, but I've already written some code to populate an array with a certain column of the flexgrid, on which I have performed calculations and written values back into the correct fields of the flexgrid - all I really need to know is about writing this back to the database. All the code you sent kinda confused me.

Thanks

 

[Norris68]

Basically you need to keep track of what you are changing and make the updates to your recordset or run an update command to duplicate them to your database. It is not dome automatically for you.