Creating And Opening Access Password Protected Databases.

A project containing all the code you need to create or open an Access Database that has password protection using DAO or ADO / ADOX code, DAO Data Control or ADODC can be downloaded here

  Download Access with Passwords Project

The project has references to DAO v3.6, ADO v 2.7 and ADOX v 2.5, all of which can co-exist in the same project as long as variables are declared specifically e.g. Dim db As DAO.Database or Dim rs As ADODB.Recordset.

Form-Level variables used in the project

Option Explicit

'DAO variables
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim tdef As DAO.TableDef
Dim fd As DAO.Field

'ADO / ADOX variables
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim col As ADOX.Column

'General variables
Dim strPassword As String       'Password to open or set on new database
Dim strSource As String         'Path and File name of source database
Dim fDAO As Boolean             'Using DAO
Dim fDC As Boolean              'Using Data control

Functions used in the project

Public Sub WriteCaptions(fDAO As Boolean)
    If strSource = "" Then
        lblDatabase.Caption = "No Current Database open"
    Else
        If fDAO Then
            If fDC Then
                lblDatabase.Caption = "Current Database = " & strSource & " Opened using DAO Data control"
            Else
                lblDatabase.Caption = "Current Database = " & strSource & " Opened using DAO Code"
            End If
        Else
            If fDC Then
                lblDatabase.Caption = "Current Database = " & strSource & " Opened using ADO Data control"
            Else
                lblDatabase.Caption = "Current Database = " & strSource & " Opened using ADO Code"
            End If
        End If
    End If
    If strPassword = "" Then
        lblPassword.Caption = "Current Password: *No Password Set*"
    Else
        lblPassword.Caption = "Current Password: " & strPassword
    End If
End Sub

Public Sub FillTableList()
    lstTables.Clear
    If fDAO Then 'using DAO code
        If fDC Then 'using data control
            For Each tdef In Data1.Database.TableDefs
                If InStr(1, tdef.Name, "MSys", vbTextCompare) = 0 Then
                    lstTables.AddItem tdef.Name
                End If
            Next tdef
        Else 'using code only
            For Each tdef In db.TableDefs
                If InStr(1, tdef.Name, "MSys", vbTextCompare) = 0 Then
                    lstTables.AddItem tdef.Name
                End If
            Next tdef
        End If
    Else 'using ADO code
        For Each tbl In cat.Tables
            If InStr(1, tbl.Name, "MSys", vbTextCompare) = 0 Then
                lstTables.AddItem tbl.Name
            End If
        Next tbl
    End If
    
    If lstTables.ListCount > 0 Then
        lstTables.ListIndex = 0
        FillFieldList lstTables.Text
    End If
End Sub

Public Sub FillFieldList(strTableName As String)
    lstFields.Clear
    
    If fDAO Then '
        If fDC Then
            For Each fd In Data1.Database.TableDefs(strTableName).Fields
                lstFields.AddItem fd.Name
            Next fd
        Else
            For Each fd In db.TableDefs(strTableName).Fields
                lstFields.AddItem fd.Name
            Next fd
        End If
    Else
        For Each col In cat.Tables(strTableName).Columns
            lstFields.AddItem col.Name
        Next col
    End If
End Sub

The code used in the project is listed on the following pages:

Homepage