ADO İle Veritabanı

 
Dim WithEvents Con As ADODB.Connection
Dim WithEvents rst As ADODB.Recordset
Dim cmd As ADODB.Command
Private Sub cmdaddnew_Click()

chec:
On Error GoTo errh

Set rst = New ADODB.Recordset 'specifying attributes to this recordset

With rst

.ActiveConnection = Con
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic

.Open "tab1" 'opening tab1 table

End With


'adding records from textbox to recordset

With rst

.AddNew

.Fields!id = StrConv(Txtid, vbProperCase)
.Fields!Name = StrConv(Txtname, vbProperCase)
.Fields!age = StrConv(Txtage, vbProperCase)
.Fields!sex = StrConv(Txtsex, vbProperCase)

.Update

End With

' clearing the text boxes

Txtname = ""
Txtid = ""
Txtage = ""
Txtsex = ""

' closing the recordset
rst.Close
Set rst = Nothing

Call dload ' calling private procedure to fill the flexgrid

errh: 'in case of error, informing the user

If Err.Description <> vbNullString Then
MsgBox Err.Description
End If


End Sub

Private Sub cmddelete_Click()

Set cmd = New ADODB.Command ' using command object to execute sql commands

With cmd

.ActiveConnection = Con
.CommandType = adCmdText
.CommandText = "delete from tab1 where id = '" & Txtid & "'"
.Execute

End With

Set cmd = Nothing

' clearing all the text boxes

Txtname = ""
Txtid = ""
Txtage = ""
Txtsex = ""

Call dload ' calling procedure to fill flexgrid


End Sub

Private Sub cmdupdate_Click()

On Error GoTo errhan

Set rst = New ADODB.Recordset

With rst

.CursorLocation = adUseClient
.ActiveConnection = Con
.CursorType = adOpenDynamic
.LockType = adLockPessimistic

.Open "select * from tab1 where id='" & Txtid.Text & "'" 'opening the recordset

.Fields!Name = StrConv(Txtname, vbProperCase)
.Fields!sex = StrConv(Txtsex, vbProperCase)
.Fields!age = StrConv(Txtage, vbProperCase)

.Update ' updating the recordset

End With

Set rst = Nothing

Call dload

Txtname = ""
Txtid = ""
Txtage = ""
Txtsex = ""

errhan:

If Err.Description <> vbNullString Then
MsgBox Err.Description
End If

End Sub
Public Sub connect()

Set Con = New ADODB.Connection

Con.CursorLocation = adUseClient

' use this code to connect to the database using universal data link

'Con.Open "File Name=" & App.Path & "\test.udl"

Con.Open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & App.Path & "\test.mdb"

If Con.Provider = "SQLOLEDB.1" Then

DataEnvironment1.Connections(2).Open Con

Else

DataEnvironment1.Connections(1).Open Con

End If

Call dload

End Sub
Private Sub dload()

MSFlexGrid1.Rows = 1

Set rst = New ADODB.Recordset

rst.ActiveConnection = Con
rst.CursorLocation = adUseClient
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
rst.Source = "tab1"
rst.Open

While Not rst.EOF() ' checking end of file

MSFlexGrid1.AddItem rst!id & Chr(9) & rst!Name & Chr(9) & rst!age & Chr(9) & rst!sex 'adding records to flexgrid

rst.MoveNext

Wend

Set rst = Nothing

End Sub

Private Sub Command1_Click()

With DataEnvironment1

If Con.Provider = "SQLOLEDB.1" Then


.Commands(2).CommandType = adCmdText
.Commands(2).CommandText = "SELECT * FROM tab1 where id = '" & Txtid.Text & "'"
.Commands(2).Execute

DataReport2.Show


If .rsCommand2.State = 1 Then

.rsCommand2.Close

End If


Else


.Commands(1).CommandType = adCmdText
.Commands(1).CommandText = "SELECT * FROM tab1 where id = '" & Txtid.Text & "'"
.Commands(1).Execute

DataReport1.Show

If .rsCommand1.State = 1 Then

.rsCommand1.Close

End If


End If

End With

End Sub

Private Sub Form_Load()

Call connect

End Sub

Private Sub Form_Unload(Cancel As Integer)

Con.Close
Set Con = Nothing

End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1 ' populating the text boxes when user clicks the flexgrid

.Col = 0
Txtid.Text = .Text
.Col = 1
Txtname.Text = .Text
.Col = 2
Txtage.Text = .Text
.Col = 3
Txtsex.Text = .Text

End With

End Sub

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

ado � le veritabanı