81
Hi,
I have created a form in Visual basic 6.0 for adding/updating the change request made by various users.
Well i am able to update the record through my code in access database.
Can anyone tell me what code should i use to Add record in the database, i also want the new record which will be added in the access database is having some unique no like CRC-CC-date/month/year-incremental number?
I mean as soon anyone will hit the add record form should become compltly blank and with a unique no as per above format.And same has to be updated in the database.
Below is my code, where i have reached
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 & ")"
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 Scriptlet1_onscriptletevent(ByVal name As String, ByVal eventData As Variant)
End Sub
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
Kindly help me. Thanx in advance.
