Connecting MS-Access 2007 Database in Visual Basic 6.0

Q. Create a form in VB 6.0 which has MS-Access 2007 as a back end database and perform operations like Save, Modify(Edit), Delete.

Sometimes, we need to connect MS-Access 2007 database through VB 6.0 as well as we want to change database from MS-Access 2002, 2003 to MS-Access 2007. It is necessary to change connectionstring only. We can do it using following connectionstring…

MS-Access 2007 Database ConnectionString:

Provider=Microsoft.ACE.OLEDB.12.0;Data Source=database_name.accdb;

Components Required (For Listview Control):

Microsoft Windows Common Controls 6.0 (SP6)

Project >> Components… (Ctrl + T) >> Tick Microsoft Windows Common Controls 6.0 (SP6) >> OK

References Required (For Database Connection Objects):

Microsoft ActiveX Data Objects 2.0 Library for Data Access

Project >> References… >> Microsoft ActiveX Data Objects 2.0 Library for Data Access

The following source code helps to get the database connection with MS-Access 2007 through VB 6.0

Source Code:

Dim ch As String
Dim Con As New ADODB.Connection
Dim rs As New ADODB.Recordset

Private Sub Form_Load()
    Call openConnection
    Call initlist
    Call Filllist
End Sub

Private Sub cmdNew_Click()
    Call clearall
    txtRno.Enabled = True
    txtRno.SetFocus
    ch = "new"
    cmdSave.Caption = "&Save"
End Sub

Private Sub cmdSave_Click()   ' Used to save and edit data
    If ch = "new" And cmdSave.Caption = "&Save" Then
        Set rs = New ADODB.Recordset
        rs.Open "Select * from Contact_Master", Con, 1, 2
        rs.AddNew
    Else
        rs.Open "Select * from Contact_Master where Rno=" & txtRno.Text, Con, 1, 2
        cmdSave.Caption = "&Save"
    End If
    rs!Rno = Val(txtRno.Text)
    rs!Nm = txtName.Text
    rs!Mob = txtContact.Text
    rs.Update
    rs.Close
    Set rs = Nothing
    Call Filllist
    Call clearall
    cmdNew.SetFocus
End Sub

Private Sub LstData_Click()  ' ListView Click Event used to perform modification
    txtRno.Enabled = False
    If LstData.ListItems.Count = 0 Then      ' ListItems Count
        MsgBox "Sorry ! Records not found !!", vbInformation, "Records Not Found"
        Exit Sub
    End If
    If LstData.ListItems.Count > 0 Then
        txtRno.Text = LstData.ListItems(LstData.SelectedItem.Index).Text
        txtName.Text = LstData.ListItems(LstData.SelectedItem.Index).ListSubItems(1).Text
        txtContact.Text = LstData.ListItems(LstData.SelectedItem.Index).ListSubItems(2).Text
    End If
    cmdSave.Caption = "&Modify"
End Sub

Private Sub cmdDelete_Click()  ' Used to delete records
    If Len(Trim(txtRno.Text)) <> 0 Then
        Set rs = New ADODB.Recordset
        rs.Open "Delete from Contact_Master where Rno=" & txtRno.Text, Con, 1, 2
        MsgBox "Record deleted successfully !", vbInformation, "Deletion Successful"
        Call Filllist
        Call clearall
        cmdSave.Caption = "&Save"
    End If
End Sub

Private Sub cmdCancel_Click() ' Reset Controls
    Call clearall
    cmdSave.Caption = "&Save"
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Con.Close ' Connection will be closed  when User closes form
    Set Con = Nothing
End Sub

Public Sub openConnection()   'Used to OpenConnection
    Set Con = New ADODB.Connection
    If Con.State = 1 Then
        Con.Close
    End If
    Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "DatabaseContacts.accdb;"
    Con.CursorLocation = adUseClient
End Sub

Public Sub clearall()        ' Clears all controls on form
    txtName.Text = ""
    txtRno.Text = ""
    txtContact.Text = ""
End Sub

Public Sub initlist()        ' Used to Inialize the properties of ListView
    With LstData
        .View = lvwReport
        .Appearance = ccFlat
        .FullRowSelect = True
        .GridLines = False
        .HotTracking = True
        .HoverSelection = True
        .HideSelection = False
        .ColumnHeaders.Add 1, "d1", "Roll Number"
        .ColumnHeaders.Add 2, "d2", "Name"
        .ColumnHeaders.Add 3, "d3", "Contact"
    End With
End Sub

Public Sub Filllist()         ' Fills data from database to listview
    Set rs = New ADODB.Recordset
    With rs
        .Open "Select * from Contact_master order by Rno", Con, 1, 2
        If .RecordCount > 0 Then
            LstData.ListItems.Clear
            .MoveFirst
            Do While rs.EOF = False
                Set Objlist = LstData.ListItems.Add(, , !Rno) ' Adds Items to List
                Objlist.SubItems(1) = !Nm
                Objlist.SubItems(2) = !Mob
                .MoveNext
            Loop
        Else
            LstData.ListItems.Clear
        End If
    .Close
    Set rs = Nothing
    End With
End Sub

Output:

Download Now (.Zip File – 40KB)…