I have a listbox that contains data from a table in a database. I am using Visual Basic 6 and Microsoft Access. I have the listbox set up when you select a row the appropriate values populate text boxes at the bottom of the form for editing purposes. I am trying to update the selected record in the listbox after the user clicks the Accept button. Currently I can't see the update until I exit the form and reopen it. Is there a way to update the selected item with the newly edited information without having to exit the form and re-enter. I want to just update the selected row and not the whole table is this possible.
Here is code from my accept button.
Private Sub btnSave_Click()
'This subroutine writes data to the database
Dim objDB As Database
Dim objRS As Recordset
Dim InputIndex As Double
Dim InputName As String
Dim InputMin As Double
Dim InputMax As Double
Dim InputPLC As String
Dim SelectedInput As String
Dim Count As Long
On Error GoTo Error_Handler
'******************************* Write to Db **************************
'Connect to database
'Break the selected input into variables
SelectedInput = glbInput
SelectedInput = Right(SelectedInput, Len(SelectedInput)) 'Trim initial tab
Count = InStr(1, SelectedInput, vbTab)
InputIndex = Left(SelectedInput, Count - 1) 'Index
SelectedInput = Right(SelectedInput, Len(SelectedInput) - Count)
Count = InStr(1, SelectedInput, vbTab)
InputName = Left(SelectedInput, Count - 1) 'Name
SelectedInput = Right(SelectedInput, Len(SelectedInput) - Count)
Count = InStr(1, SelectedInput, vbTab)
InputMin = Left(SelectedInput, Count - 1) 'RawMin
SelectedInput = Right(SelectedInput, Len(SelectedInput) - Count)
Count = InStr(1, SelectedInput, vbTab)
InputMax = Left(SelectedInput, Count - 1) 'RawMax
SelectedInput = Right(SelectedInput, Len(SelectedInput) - Count)
Count = InStr(1, SelectedInput, vbTab)
InputPLC = Right(SelectedInput, Len(SelectedInput) - Count) 'Grouping
'Retrieving all values from database
Set objRS = glbCurrentDB.OpenRecordset("SELECT * FROM [tblInput] WHERE ([Index] = " & InputIndex & ")", dbOpenDynaset)
objRS.Edit
'objRS![Index] = txtIndexNum
objRS![Name] = txtName
objRS![RawMin] = Val(txtMin)
objRS![RawMax] = Val(txtMax)
objRS![PLC] = txtPLC
objRS.Update
'Clear database from memory.
Set objRS = Nothing
'Set value for list highlight
glbInput = vbTab & txtIndexNum & vbTab & txtName & vbTab & Val(txtMin) & vbTab & Val(txtMax) & vbTab & txtPLC
'Unload Me
'Clears text boxes content
txtIndexNum.Text = ""
txtName.Text = ""
txtMin.Text = ""
txtMax.Text = ""
txtPLC.Text = ""
Me.Refresh
lstInput.Refresh
Exit Sub
Error_Handler:
Set objRS = Nothing
MsgBox Err.Description, 16, "Error Writing to Table"
Unload Me
End SubHere is code from my listbox
Private Sub lstInput_Click()
'This subroutine prepares fields for editing
Dim objDB As Database
Dim objRS As Recordset
Dim InputIndex As Double
Dim InputName As String
Dim InputMin As Double
Dim InputMax As Double
Dim InputPLC As String
Dim SelectedInput As String
Dim Count As Long
'Set highlighted record variable
glbInput = lstInput.Text
'Error Handling
On Error GoTo Error_Handler
'Enables buttons, labels and textboxes if listbox contains value
If lstInput.ListIndex > -1 Then
btnSave.Enabled = True
btnSave.BackColor = glbLtGreen
btnCancel.Enabled = True
btnCancel.BackColor = glbColorRed
lblIndex.Enabled = False
lblName.Enabled = True
lblMin.Enabled = True
lblMax.Enabled = True
lblPLC.Enabled = True
lblIndex.BackColor = glbColorCream
txtIndexNum.Enabled = False
txtIndexNum.BackColor = glbColorLtGray
txtName.Enabled = True
txtName.BackColor = glbColorWHite
txtMin.Enabled = True
txtMin.BackColor = glbColorWHite
txtMax.Enabled = True
txtMax.BackColor = glbColorWHite
txtPLC.Enabled = True
txtPLC.BackColor = glbColorWHite
Shape1.BackColor = glbColorWHite
Else
'Disables buttons, labels and textboxes if listbox doesn't contain value
btnSave.Enabled = False
btnSave.BackColor = glbColorLtGray
btnCancel.Enabled = False
btnCancel.BackColor = glbColorLtGray
lblName.Enabled = False
lblMin.Enabled = False
lblMax.Enabled = False
lblPLC.Enabled = False
txtIndexNum.Enabled = False
txtIndexNum.BackColor = glbColorLtGray
txtName.Enabled = False
txtName.BackColor = glbColorLtGray
txtMin.Enabled = False
txtMin.BackColor = glbColorLtGray
txtMax.Enabled = False
txtMax.BackColor = glbColorLtGray
txtPLC.Enabled = False
txtPLC.BackColor = glbColorLtGray
Shape1.BackColor = glbColorLtGray
End If
'Break the selected input into variables
SelectedInput = glbInput
SelectedInput = Right(SelectedInput, Len(SelectedInput)) 'Trim initial tab
Count = InStr(1, SelectedInput, vbTab)
InputIndex = Left(SelectedInput, Count - 1)
SelectedInput = Right(SelectedInput, Len(SelectedInput) - Count)
Count = InStr(1, SelectedInput, vbTab)
InputName = Left(SelectedInput, Count - 1)
SelectedInput = Right(SelectedInput, Len(SelectedInput) - Count)
Count = InStr(1, SelectedInput, vbTab)
InputMin = Left(SelectedInput, Count - 1)
SelectedInput = Right(SelectedInput, Len(SelectedInput) - Count)
Count = InStr(1, SelectedInput, vbTab)
InputMax = Left(SelectedInput, Count - 1)
SelectedInput = Right(SelectedInput, Len(SelectedInput) - Count)
Count = InStr(1, SelectedInput, vbTab)
InputPLC = Right(SelectedInput, Len(SelectedInput) - Count)
'Initialize display
'Sets values of textboxes
txtIndexNum = InputIndex
txtName = InputName
txtMin = InputMin
txtMax = InputMax
txtPLC = InputPLC
Exit Sub
Error_Handler:
MsgBox Err.Description, 16, "Error Locating Record"
End SubHere is how the listbox is populated.
Sub UpdateList()
'This subroutine updates the input list
Dim TabSpace(4) As Long
Dim objRec As Recordset
Dim LastEntry As String
Dim Stage As Integer
On Error GoTo ERRORHANDLER
'Define tab spacing
TabSpace(0) = 2 'Initial Space
TabSpace(1) = 25 'After Index
TabSpace(2) = 235 'After Name
TabSpace(3) = 260 'After RawMin
TabSpace(4) = 295 'After RawMax
'Set tab spacing API
Call SendMessage(frmEditPoints.lstInput.hwnd, LB_SETTABSTOPS, UBound(TabSpace) + 1, TabSpace(0))
'Connect to database
Set objRec = glbCurrentDB.OpenRecordset("SELECT * FROM tblInput", , dbOpenForwardOnly)
While Not objRec.EOF
frmEditPoints.lstInput.AddItem objRec![Index] & vbTab & objRec![Name] & vbTab & objRec![RawMin] & vbTab & objRec![RawMax] & vbTab & objRec![PLC]
objRec.MoveNext
Wend
'Define last entry for use
If frmEditPoints.lstInput.ListCount > 0 Then LastEntry = frmEditPoints.lstInput.List(frmEditPoints.lstInput.ListCount - 1)
'Clear list
'frmEditPoints.lstInput.Clear
Set objRec = Nothing
Exit Sub
ERRORHANDLER:
MsgBox Err.Description, 16, "Error Populating Input List"
End SubThanks in advance
Alicia
