By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,952 Members | 1,384 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,952 IT Pros & Developers. It's quick & easy.

To Add record in Database

P: 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.
Sep 17 '07 #1
Share this Question
Share on Google+
3 Replies


hariharanmca
100+
P: 1,977
You never point what you had tried for insert query.

let cn is your connection

Expand|Select|Wrap|Line Numbers
  1. Dim strSql as string
  2.  
  3. strSql="Insert into <Table Name> (field1,field2,field3) values("  & value1 & ", "  & value1 & ", "  & value1 & ")".
  4. cn.Execute strsql
Sep 17 '07 #2

P: 81
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.Connection
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.
Sep 17 '07 #3

hariharanmca
100+
P: 1,977
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.Connection
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..

Expand|Select|Wrap|Line Numbers
  1. strSql = "Insert into clients (txtUsername) values(" & CRC-CC-today()-n & ")"
  2. cn.Execute strSql
  3.     strSql = "Insert into clients (txtUsername) values('" & CRC-CC-today()-n+1 & "')"
  4.     cn.Execute strSql

For value type the single quote will not be there
it will appear for String and date time type data.
Sep 17 '07 #4

Post your reply

Sign in to post your reply or Sign up for a free account.