pablopadin
Nuevo
- Registrado
- 15 Jul 2017
- Mensajes
- 1
- Puntos
- 0
- Edad
- 46
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
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