Private Sub CommandButton1_Click()
Dim cn As ADODB.Connection
Dim rst As ADODB.Recordset

    dbFileName = Application.GetOpenFilename _
        ("Access Files (*.accdb), *.accdb")
    If dbFileName = False Then Exit Sub

    Set cn = New ADODB.Connection
    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & dbFileName & ";Mode=Read"
    On Error Resume Next
    cn.Open

    If cn.State = 1 Then
        ListBox1.Clear
        ListBox1.ColumnWidths = "100,200"
        Set rst = New ADODB.Recordset
        Set rst = cn.OpenSchema(adSchemaTables)
        rst.MoveFirst
        Do While Not rst.EOF
            ListBox1.AddItem
            ListBox1.List(ListBox1.ListCount - 1, 0) = rst.Fields.Item("TABLE_TYPE")
            ListBox1.List(ListBox1.ListCount - 1, 1) = rst.Fields.Item("TABLE_NAME")
            rst.MoveNext
        Loop
        rst.Close
        Set rst = Nothing
    Else
        MsgBox "Íå óäàåòñÿ ïîäêëþ÷èòüñÿ ê áàçå" & vbCr & dbFileName
        dbFileName = False
    End If
    cn.Close
    Set cn = Nothing
    Label1.Caption = dbFileName

End Sub