Update Existing Data

[kcal]

Hi

could anyone give me some advice where I can get some simple examples of updating data in VB and populating the access database.

Example

If I want to update an existing field on a record - Client table - update Telephone field.

thanks

[danp129]

'This is an example of searching/updating a database from VB6
'Search example is in cmdSearch_click and the update example is in cmdUpdate_click
 
'For this example you need to do the following
'Add reference: Microsoft ActiveX Data Objects x.x Library (use latest version installed)
'Add component: Microsoft Windows Common Controls 6 sp6
'Add command buttons: cmdSearch, cmdUpdate
 
'Add textboxes: ...
'txtSearch
'txtClient_id
'txtUsername
'txtName_First
'txtName_Last
'txtPhone
 
'Make new access database called MyDB.mdb in path of saved project
'Make table in database called clients
'Make fields in table called:...
'client_id      autonumber
'username       text
'name_first     text
'name_last      text
'phone          text
 
'Add some mock client info to the database manually in access
 
Option Explicit
'Set path to DB
'Note project must be saved or compiled for app.path to work
'This assumes db is in same folder as project/exe
Dim strMyDB As String
Const DefaultSearchText = "Search For Client"
 
Private Sub Form_Load()
    strMyDB = App.Path & "\" & "MyDB.mdb"
    txtSearch.Text = DefaultSearchText
End Sub
 
Private Sub cmdSearch_Click()
    'Search for a client
 
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strSQL As String
    Dim arWords, iWord As Long
    Dim xItem As ListItem
    Dim curField As Field
    Dim i As Integer
    lvClients.ListItems.Clear
    lvClients.ColumnHeaders.Clear
 
    'Open DB connection
    'for other DB connection strings go to http://www.thescripts.com/forum/thread572278.html
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & strMyDB & ";"
 
    'Put the words searched for into an array and fix any apostrophies
    arWords = Split(FixApostrophies(txtSearch.Text), " ")
 
    'Start query
    strSQL = "SELECT * FROM clients WHERE"
 
    'Build filter requiring all words entered
    '   to be in username, name_first, or name_last field
    For iWord = 0 To UBound(arWords)
        If iWord > 0 Then strSQL = strSQL & " AND"
        strSQL = strSQL & " ("
        strSQL = strSQL & "username like '%" & arWords(iWord) & "%'"
        strSQL = strSQL & " OR"
        strSQL = strSQL & " name_first like '%" & arWords(iWord) & "%'"
        strSQL = strSQL & " OR"
        strSQL = strSQL & " name_last like '%" & arWords(iWord) & "%'"
        strSQL = strSQL & ")"
    Next 'iWord
 
    'Query the database
    rs.Open strSQL, cn
 
    'Create column headers for listview based on field names
    If Not rs.EOF Then
        For Each curField In rs.Fields
            lvClients.ColumnHeaders.Add , , curField.Name
        Next 'curField
    End If
 
    'Populate listview with recordset
    While Not rs.EOF
        'Debug.Print rs("username") & vbTab & rs("phone")
        Set xItem = lvClients.ListItems.Add(, , rs.Fields(0).Value)
        For i = 1 To (rs.Fields.Count - 1)
            xItem.ListSubItems.Add , , rs.Fields(i).Value
        Next
        'Move to next record in recordset
        rs.MoveNext
    Wend
 
    'close recordset/connection
    rs.Close
    cn.Close
    'remove references
    Set rs = Nothing
    Set cn = Nothing
End Sub
 
Private Sub cmdUpdate_Click()
    'Update client's record
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strSQL As String
 
    'Open DB connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & strMyDB & ";"
 
    'create SQL statement to select client from a unique record id
    strSQL = "SELECT * FROM clients" & _
        " WHERE client_id=" & FixApostrophies(txtClient_Id.Text)
 
    rs.Open strSQL, cn, adOpenForwardOnly, adLockOptimistic
 
    'See if there's a record found
    If rs.EOF Then
        'record not found
        MsgBox "That record no longer exists"
    Else
        'record found, update record
        rs("username") = txtUsername.Text
        rs("name_last") = txtName_Last.Text
        rs("name_first") = txtName_First.Text
        rs("phone") = txtPhone.Text
        'update the recordset
        rs.Update
    End If
    'close recordset/connection
    rs.Close
    cn.Close
    'remove references
    Set rs = Nothing
    Set cn = Nothing
End Sub
 
Private Sub lvClients_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Dim header As ColumnHeader
    Dim ret
 
    'Loop through column headers, and populate textboxes with same name (but have 'txt' prefix)
    For Each header In lvClients.ColumnHeaders
        On Error Resume Next
        ret = Me.Controls("txt" & header.Text)
        If Err.Number <> 0 Then
            MsgBox Err.Description
            Err.Clear
            On Error GoTo 0
            GoTo NextHeader:
        End If
 
        If header.Index > 1 Then
            Me.Controls("txt" & header.Text).Text = Item.ListSubItems(header.Index - 1).Text
        Else
            Me.Controls("txt" & header.Text).Text = Item.Text
        End If
NextHeader:
    Next 'header
End Sub
 
Function FixApostrophies(ByVal sInput As String) As String
    'Use for text that will be included as part of a query
    If InStr(1, sInput, "'") Then
        'Fix apostrophies
        FixApostrophies = Replace(sInput, "'", "''")
    Else
        FixApostrophies = sInput
    End If
End Function
 
Function RandomInt(ByVal HighVal As Long, Optional ByVal LowVal As Long = 0) As Long
    Randomize
    RandomInt = CLng((HighVal * Rnd) + LowVal)
End Function
 
Private Sub txtClient_Id_Change()
    cmdUpdate.Enabled = True
End Sub
 
'########### Everthing below is unnecessary code ##########
Private Sub txtSearch_GotFocus()
    cmdSearch.Default = True
    If txtSearch.Text <> "" And txtSearch.Text = DefaultSearchText Then
        txtSearch.Text = Empty
    Else
        txtSearch.SelStart = 0
        txtSearch.SelLength = Len(txtSearch.Text)
    End If
End Sub
 
 
Private Sub txtSearch_LostFocus()
    cmdSearch.Default = False
    If txtSearch.Text = "" Then txtSearch.Text = DefaultSearchText
End Sub