Updating selected listbox item

Question

SHAWTY721 0 Newbie Poster

15 Years Ago

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 Sub

Here 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 Sub

Here 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 Sub

Thanks in advance
Alicia

visual-basic-6

3 Contributors
2 Replies
219 Views
1 Week Discussion Span
Latest Post 15 Years Ago Latest Post by dspnhn

All 2 Replies

aktharshaik 16 Posting Whiz

15 Years Ago

Just put the following line in the
btnSave_Click() event

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
[B][I]'Also here remove the first vbtab[/I][/B]
glbInput = [B][I]vbTab &[/I][/B] txtIndexNum & vbTab & txtName & vbTab & Val(txtMin) & vbTab & Val(txtMax) & vbTab & txtPLC

    lstInput.List(lstInput.ListIndex) = glbInput

'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 Sub

Reply to this topic

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.

dspnhn 10 Junior Poster in Training · Answer 1 · 2008-08-22T09:20:00+00:00

What i would do for a similar concept is create a procedure named loadlist and write all the coe to populate list with table records. Later where ever required...like for example when u press accept button just call this procedure first and do your thing after that.

PS-BE SURE TO CLEAR THE LIST FIRST AS THIS WOULD RESULT IN DUPLICATE ENTRIES IN THE LIST

Regards
DSP

Updating selected listbox item

Recommended Answers Collapse Answers

All 2 Replies

Recommended Answers