To Add record in Database

[smugcool]

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 = DefaultSearchTe xt
End Sub

Private Sub cmdSearch_Click ()
'Search for a client

Dim cn As New ADODB.Connectio n
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.ListI tems.Clear
lvClients.Colum nHeaders.Clear

'Open DB connection
'for other DB connection strings go to http://www.thescripts. com/forum/thread572278.ht ml
cn.Open "Provider=Micro soft.Jet.OLEDB. 4.0;" & _
"Data Source=" & strMyDB & ";"

'Put the words searched for into an array and fix any apostrophies
arWords = Split(FixApostr ophies(txtSearc h.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.Colum nHeaders.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.ListI tems.Add(, , rs.Fields(0).Va lue)
For i = 1 To (rs.Fields.Coun t - 1)
xItem.ListSubIt ems.Add , , rs.Fields(i).Va lue
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.Connectio n
Dim rs As New ADODB.Recordset
Dim strSQL As String

'Open DB connection
cn.Open "Provider=Micro soft.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.T ext)

rs.Open strSQL, cn, adOpenForwardOn ly, adLockOptimisti c

'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.Tex t
rs("name_last" ) = txtName_Last.Te xt
rs("name_first" ) = txtName_First.T ext
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_ItemC lick(ByVal Item As MSComctlLib.Lis tItem)
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.Colum nHeaders
On Error Resume Next
ret = Me.Controls("tx t" & 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("tx t" & header.Text).Te xt = Item.ListSubIte ms(header.Index - 1).Text
Else
Me.Controls("tx t" & header.Text).Te xt = 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_onsc riptletevent(By Val name As String, ByVal eventData As Variant)

End Sub

Private Sub txtClient_Id_Ch ange()
cmdUpdate.Enabl ed = True
End Sub

'########### Everthing below is unnecessary code ##########
Private Sub txtSearch_GotFo cus()
cmdSearch.Defau lt = True
If txtSearch.Text <> "" And txtSearch.Text = DefaultSearchTe xt Then
txtSearch.Text = Empty
Else
txtSearch.SelSt art = 0
txtSearch.SelLe ngth = Len(txtSearch.T ext)
End If
End Sub


Private Sub txtSearch_LostF ocus()
cmdSearch.Defau lt = False
If txtSearch.Text = "" Then txtSearch.Text = DefaultSearchTe xt
End Sub



Kindly help me. Thanx in advance.

[hariharanmca]

You never point what you had tried for insert query.

let cn is your connection

[CODE=vb]Dim strSql as string

strSql="Insert into <Table Name> (field1,field2, field3) values(" & value1 & ", " & value1 & ", " & value1 & ")".
cn.Execute strsql[/CODE]

[smugcool]

actually i tried few things but didn't work.

I have the tried the above code which is given by you, but it is also not working i am geting error of Sub/function not defined,

Private Sub CmdAdd_Click()
Dim strSql As String
Dim cn As New ADODB.Connectio n
Dim n As String
Where n = 0
strSql = "Insert into <clients> (txtUsername),v alues(CRC-CC-today()-n)"
strSql = "Insert into <clients> (txtUsername),v alues(CRC-CC-today()-n+1)"
cn.Execute strSql
End Sub

Above is the code. Plz go thru it if its correct or changes required.

[hariharanmca]

actually i tried few things but didn't work.

I have the tried the above code which is given by you, but it is also not working i am geting error of Sub/function not defined,

Private Sub CmdAdd_Click()
Dim strSql As String
Dim cn As New ADODB.Connectio n
Dim n As String
Where n = 0
strSql = "Insert into <clients> (txtUsername),values(CRC-CC-today()-n)"
strSql = "Insert into <clients> (txtUsername),values(CRC-CC-today()-n+1)"
cn.Execute strSql
End Sub

Above is the code. Plz go thru it if its correct or changes required.

I think CRC-CC-today() is an VB method and also n.
so the code will be..

[CODE=vb]strSql = "Insert into clients (txtUsername) values(" & CRC-CC-today()-n & ")"
cn.Execute strSql
strSql = "Insert into clients (txtUsername) values('" & CRC-CC-today()-n+1 & "')"
cn.Execute strSql[/CODE]


For value type the single quote will not be there
it will appear for String and date time type data.