La Web del Programador: Comunidad de Programadores
 
    Pregunta:  20467 - COMO ABRIR UNA BASE DE ACCES QUE TIENE UNA PASSWOR CON ADO
Autor:  Christian Domenichelli
Estoy tratando de escrbir el codigo para abrir una base de acces que contiene una password y no logro que esta se conecte, ademas los controles como el Data Envairomen o el AdoDatacontrol tampo pueden llegar a conectarse cuando la base tiene una passwor. Lo extraño de esto es que sin password si logro conectarme y tambien los controles.
Trabajo con Visual Basic 6 son el Service Pack 5. y la base de acces es de la version 97.
Si alguien sabe como hacerlo le agradeceria mucho un ejemplo muchas gracias.

  Respuesta:  Oswaldo Monagas
Aqui tienes el codigo para hacerlo, esta es un forma, pero hay otra mas.

'DAO:
Public Function OpenPasswordProtectedDatabase(DBPath As String, _
Password As String) As Object

'DBPath: Trayectoria de la base de datos Access
'Password: La Password

On Error Resume Next
Dim db As DAO.Database

Set db = DAO.OpenDatabase(DBPath, False, False, _
";pwd=" & Password)

If Err.Number = 0 Then
Set OpenPasswordProtectedDatabase = db
Else
Set OpenPasswordProtectedDatabase = Nothing
End If

End Function

'ADO:
'Abrir una Base de Datos con Clave desde VB

Dim BDatos As Database
Set BDatos = DBEngine.OpenDataBase("Path:\Base.mdb", False, _ False, ";Pwd=clave de la Base")

'Otro Codigo
Conectarse a una base de datos Jet con contraseña simple

¿Como conectar un control Data a un base de datos protegida con contraseña simple?. Ejemplos:
En tiempo de ejecución:
Set db = DBEngine(0).OpenDatabase(BaseDeDatos, False, True, ";PWD=miPWD")
...
With dat
.DatabaseName = db.Name
.Connect = db.Connect
.RecordSource = miSQL
.Refresh
End With
En en tiempo de diseño asignamos a la propiedad Connect la línea:
;PWD=miPWD

Otra forma:

Function OpenDB(ByVal DBFileLocation As String) As Boolean
Dim strcn As String
On Error GoTo errorDB
strcn = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & DBFileLocation & ";" _ ' Localizacion de la BD
& "Persist Security Info=False;" _
& "Jet OLEDB:Database Password=" & DBPassword ' Password de la BD

Set cnConexionJet = New Connection
cnConexionJet.Open strcn
OpenDB = True
Exit Function

errorDB:
OpenDB = False
MsgBox "Error: " & Err.Number & ". " & Err.Description
End Function

Otra forma:
Dim strPassw as string

strPassw = ";database=NombreBaseDatos.mdb;pwd=tuclave" 'Constante del password de acceso a la BD
Set db = DBEngine.Workspaces(0).OpenDatabase("", False, False, strPassw)

No creo que necesites mas.
Saludos