AYUDA Copiar datos en Excel de una BD Access Office 2010

Buenas:

Alguien me puede ayudar???
He copiado el siguiente código de alguna página de la web y no consigo realizar la conexión cuando la base de datos tiene contraseña:

Lo que necesito hacer es copiar los datos que hay en una tabla "T_AAG_Lista_Ing_Elect" de una Base de Datos "BD_General.accdb" con una contraseña "123".

Me saca el siguiente error: "Se ha producido el error '-2147467259 (80004005)' en tiempo de ejecución: No es una contraseña válida.

Si elimino la contraseña, a la base de datos, todo funciona perfectamente.

Este es el código que tengo creado...

Sub Actualizar_T_AGG_Lista_Ing_Elect()
Dim Ruta_BD As String
Dim strConn As String
Dim cs As String
Dim Cnn As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
Dim StrDB, StrSQL As String
Dim StrTabla As String
Dim LngCampos As Long
Dim i As Long
Dim bBien As Boolean

On Error GoTo Fallo
bBien = True

Sheets("T_AAG_Lista_Ing_Elect").Visible = True
'Conectamos con la Base de Datos

Ruta_BD = "E:\00.-BD\BD_General.accdb"
Cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
Cnn.Properties("Data Source") = Ruta_BD
'EN CASO QUE LA BASE DE DATOS TENGA UNA CONTRASEÑA, SE DEBE PONER AQUÍ
Cnn.Properties("Jet OLEDB: Database Password") = "123"
Cnn.Open

StrTabla = "AAG_Lista_Ing_Elect"
StrSQL = "SELECT * FROM " & StrTabla & " "
RecSet.Open StrSQL, Cnn
'COPIAR LOS DATOS A LA HOJA
Worksheets("T_AAG_Lista_Ing_Elect").Select
'LIPIAMOS DATOS DE EXCEL ANTES DE ACTUALIZAR
limpiardatos = Sheets("T_AAG_Lista_Ing_Elect").Range("A" & Rows.Count).End(xlUp).Row
Sheets("T_AAG_Lista_Ing_Elect").Range("A2:z" & limpiardatos).ClearContents
'GRABAMOS NUEVA BASE DE DATOS DE ACCESS
Sheets("T_AAG_Lista_Ing_Elect").Cells(2, 1).CopyFromRecordset RecSet
'COPIAMOS RÓTULOS
LngCampos = RecSet.Fields.Count
For i = 0 To LngCampos - 1
Sheets("T_AAG_Lista_Ing_Elect").Cells(1, i + 1).Value = RecSet.Fields(i).Name
Next
'DESCONECTAMOS
RecSet.Close: Set RecSet = Nothing
Cnn.Close: Set Cnn = Nothing
Sheets("Ingeniería").Select
'Sheets("T_AAG_Lista_Ing_Elect").Visible = False
MsgBox "La Lista de Actividades de Ingeniería y Eléctricas ha sido Actualizada."
Salir:
On Error Resume Next
If Not bBien Then
'Sheets("T_AAG_Lista_Ing_Elect").Visible = False
MsgBox "No se ha podido actualizar la Lista de Actividades, inténtalo más tarde."
End If
RecSet.Close: Set RecSet = Nothing
Cnn.Close: Set Cnn = Nothing
Exit Sub
Fallo:
bBien = False
Resume Salir
End Sub

Espero la ayuda de alguien!!!
GRACIAS