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!*** = StrConv(Txt***, vbProperCase)
 
    .Update
 
End With
 
' clearing the text boxes
 
Txtname = ""
Txtid = ""
Txtage = ""
Txt*** = ""
 
' 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 = ""
Txt*** = ""
 
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!*** = StrConv(Txt***, vbProperCase)
    .Fields!age = StrConv(Txtage, vbProperCase)
 
    .Update ' updating the recordset
 
End With
 
Set rst = Nothing
 
Call dload
 
Txtname = ""
Txtid = ""
Txtage = ""
Txt*** = ""
 
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!*** '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
        Txt***.Text = .Text
 
End With
 
End Sub