No se ejecuta el código
Hola experto_ jcgonzalez 3165 nuevamente molestandote, pero el código con el que he estado trabajando para exportar datos especificos de access a una tabla de amortización de excel no se ejecuta y me señala varios errores (anteriormente te envíe la pregunta "Error de Compilación Sub o Function), me enviaste un código y me pediste que analizara la parte de conexiones de ADO para modificarlo a mis necesidades o bien en su caso rehacer el código, bien considere que lo mejor era hacer nuevamente el código pero este presenta errores, por lo que la rutina de exportar datos no se lleva a cabo, agracedere de favor si puedes revisar el código que te envío y puedas apoyarme a fin de que encuentre la solución de mi proyecto, te transcribo el código completo:
Se hizo en dos módulos, el primero un temporizador y el segundo para hacer la conexión a access
Modulo 1) Activar un temporizador para actualizar los datos cada 5 segundos
Public DatHora As Date
Public Const conIntervalo = 5 '5 segundos
Public Const conRunMacro = "Actualizar_Access"
' Iniciar temporizador
Sub StartTemporizador()
DatHora = Now + TimeSerial(0, 0, conIntervalo)
' Iniciar el temporizador
Application.On Time _
Earliesttime:=DatHora, _
Procedure:=conRunMacro, _
Schedule:=True
End Sub
' Actualizar
Sub Actualizar_Access()
Run ("Conectar_Access")
Run ("Importar_Access")
Run ("Desconectar_Access)
' reiniciar el temporizador
StartTemporizador
End Sub
' Terminar temporizador
Sub StopTemporizador()
On Error Resume Next
' desactivar el temporizador
Application.OnTime _
Earliesttime:=DatHora, _
Procedure:=conRunMacro, _
Schedule:=False
End Sub
Modulo 2) Para hacer la conexión a access
Sub Conectar_Access()
'
' Conectar_Access Macro
'
' Acceso directo: CTRL +m
'
End Sub
Public Sub cmdConectar_Access()
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim Connection As ADODB.Connection {Error 1}
Dim recSet As ADODB.Recordset
Dim strDB, strSQL As String
Dim strTabla As String
Dim IngTablas As Long
Dim i As Long
' Ruta de acceso misma carpeta
strDB = ThisWorkbook.Path & "\" & "Administración Cartera bd1.mdb
' Nombre de los archivos de access
' construyo la primera cadena de la SELECT
strSQL = SELECT No de Control, Crédito No, Plazo " & _
"FROM 4Formulario Resumen de Ministración Mensual ORDER BY No de Control"
xls.ActiveSheet.Range("A1:R26").Select
For Each Campo In rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
xls.ActiveSheet.Cells(3, 3) = Campo.Plazo
' construyo segunda cadena de la SELECT
strSQL = "SELECT No de Control, Crédito No, Fecha de Ministración" & _
"FROM 3Detalle de la Ministración ORDER BY No de Control
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
xls.ActiveSheet.Cells(3, 4) = Campo.Fecha_Inicial
' construyo la tercera cadena de la SELECT
strSQL = "SELECT No de control, Crédito No, Fecha de Ministración " & _
"FROM 4Resumen de Ministración Mensual ORDER BY No de Control"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Range("J3:J26") = Campo.Importe_Ministrado
' construyo la cuarta cadena de la SELECT
strSQL = "SELECT No de Control, Crédito No, Fecha de Ministración " & _
"FROM 3Formulario Detalle de la Ministración ORDER BY No de Control"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
' construyo la quinta cadena de la SELECT
strSQL = "SELECT No de Control, Crédito No, Fecha de Ministración " & _
"FROM 5Formulario Resumen de Amortización Mensual ORDER BY No de Control"
xls.ActiveSheet.Range(A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
' construyo la sexta cadena de la SELECT
strSQL = "SELECT No de Control, Crédito No, Fecha, Mes " & _
"FROM 5Resumen de Amortización Mensual ORDER BY No de Control"
xls.ActiveSheet.RAnge("A1:R26").Select
rst.ActiveSheet.Range("K3:K26") = Campo.Importe_del_Pago
' construyo la septima cadena de la SELECT
strSQL = "select No de Control, Crédito No, " & _
"FROM 4Formulario Detalle de la Amortización ORDER BY No de Control"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cell(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
' crear la conexión
Set Connection = New ADODB.Connection
Set recSet = New ADODB.Recordset
Connection.Open "Provider=Microsoft.Jet.OLEDB.4.0:"& _
"Data Source =" & strDB & ";"
End Sub
Sub Importar_Access()
' abrir el libro ExportaraExcel
strLibro = CurrentProject.Path & "\TabAmort.xls.xls"
xls.Workbooks.Open (strLibro) {error 2, 3, 4}
' visible o no
xls.Visible = FAlse ' o false
' activo la hoja 4 de excel denominada "TabAmort"
xls.Worksheets("\TabAmort.xls").Activate
' cosnulta SQL
strSQL = "SELECT * FROM " & strTabla & """"
recSet.Open strSQL, Connection
' copiar datos a la hoja
ActiveSheet.Cells(3, 1).CopyFromRecordset recSet
' copiar rótulos
IngCampos = recSet.Fiels.Count
For I = 0 To IngCaAmpos - 1
ActiveSheet.Cells(1, I + 1).Value = recSet.Fields(I).Name
Next
End Sub
Sub Desconectar_Access()
' Desconectar
recSet.Close: Set recSet = Nothing {error 5}
End Sub
---------------------------------------------------------------------------------------------------------
Clave de errores:
Error 1) corresponde a la macro cmdConectar_Access = No se ha definido el tipo definido por el usuario
Error 2, 3, 4) corresponde a las macros Actualizar_Access, Importar_Access y Start Temporizador = "424" en tiempo de ejecución: Se requiere un objeto.
Error 5) corresponde a la macro Desconectar_Access = "424" en tiempo de ejecución: se requiere un objeto.
Al fin termine, pero considere necesario transcribirte todo el código para que de favor si lo puedes revisar y, con tus conocimientos y experiencia me puedas a apoyar a corregirlos a fin de que se pueda ejecutar satisfactoriamente los...
Se hizo en dos módulos, el primero un temporizador y el segundo para hacer la conexión a access
Modulo 1) Activar un temporizador para actualizar los datos cada 5 segundos
Public DatHora As Date
Public Const conIntervalo = 5 '5 segundos
Public Const conRunMacro = "Actualizar_Access"
' Iniciar temporizador
Sub StartTemporizador()
DatHora = Now + TimeSerial(0, 0, conIntervalo)
' Iniciar el temporizador
Application.On Time _
Earliesttime:=DatHora, _
Procedure:=conRunMacro, _
Schedule:=True
End Sub
' Actualizar
Sub Actualizar_Access()
Run ("Conectar_Access")
Run ("Importar_Access")
Run ("Desconectar_Access)
' reiniciar el temporizador
StartTemporizador
End Sub
' Terminar temporizador
Sub StopTemporizador()
On Error Resume Next
' desactivar el temporizador
Application.OnTime _
Earliesttime:=DatHora, _
Procedure:=conRunMacro, _
Schedule:=False
End Sub
Modulo 2) Para hacer la conexión a access
Sub Conectar_Access()
'
' Conectar_Access Macro
'
' Acceso directo: CTRL +m
'
End Sub
Public Sub cmdConectar_Access()
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim Connection As ADODB.Connection {Error 1}
Dim recSet As ADODB.Recordset
Dim strDB, strSQL As String
Dim strTabla As String
Dim IngTablas As Long
Dim i As Long
' Ruta de acceso misma carpeta
strDB = ThisWorkbook.Path & "\" & "Administración Cartera bd1.mdb
' Nombre de los archivos de access
' construyo la primera cadena de la SELECT
strSQL = SELECT No de Control, Crédito No, Plazo " & _
"FROM 4Formulario Resumen de Ministración Mensual ORDER BY No de Control"
xls.ActiveSheet.Range("A1:R26").Select
For Each Campo In rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
xls.ActiveSheet.Cells(3, 3) = Campo.Plazo
' construyo segunda cadena de la SELECT
strSQL = "SELECT No de Control, Crédito No, Fecha de Ministración" & _
"FROM 3Detalle de la Ministración ORDER BY No de Control
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
xls.ActiveSheet.Cells(3, 4) = Campo.Fecha_Inicial
' construyo la tercera cadena de la SELECT
strSQL = "SELECT No de control, Crédito No, Fecha de Ministración " & _
"FROM 4Resumen de Ministración Mensual ORDER BY No de Control"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Range("J3:J26") = Campo.Importe_Ministrado
' construyo la cuarta cadena de la SELECT
strSQL = "SELECT No de Control, Crédito No, Fecha de Ministración " & _
"FROM 3Formulario Detalle de la Ministración ORDER BY No de Control"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
' construyo la quinta cadena de la SELECT
strSQL = "SELECT No de Control, Crédito No, Fecha de Ministración " & _
"FROM 5Formulario Resumen de Amortización Mensual ORDER BY No de Control"
xls.ActiveSheet.Range(A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
' construyo la sexta cadena de la SELECT
strSQL = "SELECT No de Control, Crédito No, Fecha, Mes " & _
"FROM 5Resumen de Amortización Mensual ORDER BY No de Control"
xls.ActiveSheet.RAnge("A1:R26").Select
rst.ActiveSheet.Range("K3:K26") = Campo.Importe_del_Pago
' construyo la septima cadena de la SELECT
strSQL = "select No de Control, Crédito No, " & _
"FROM 4Formulario Detalle de la Amortización ORDER BY No de Control"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cell(3, 1) = Campo.No_de_Control
xls.ActiveSheet.Cells(3, 2) = Campo.Crédito_No
' crear la conexión
Set Connection = New ADODB.Connection
Set recSet = New ADODB.Recordset
Connection.Open "Provider=Microsoft.Jet.OLEDB.4.0:"& _
"Data Source =" & strDB & ";"
End Sub
Sub Importar_Access()
' abrir el libro ExportaraExcel
strLibro = CurrentProject.Path & "\TabAmort.xls.xls"
xls.Workbooks.Open (strLibro) {error 2, 3, 4}
' visible o no
xls.Visible = FAlse ' o false
' activo la hoja 4 de excel denominada "TabAmort"
xls.Worksheets("\TabAmort.xls").Activate
' cosnulta SQL
strSQL = "SELECT * FROM " & strTabla & """"
recSet.Open strSQL, Connection
' copiar datos a la hoja
ActiveSheet.Cells(3, 1).CopyFromRecordset recSet
' copiar rótulos
IngCampos = recSet.Fiels.Count
For I = 0 To IngCaAmpos - 1
ActiveSheet.Cells(1, I + 1).Value = recSet.Fields(I).Name
Next
End Sub
Sub Desconectar_Access()
' Desconectar
recSet.Close: Set recSet = Nothing {error 5}
End Sub
---------------------------------------------------------------------------------------------------------
Clave de errores:
Error 1) corresponde a la macro cmdConectar_Access = No se ha definido el tipo definido por el usuario
Error 2, 3, 4) corresponde a las macros Actualizar_Access, Importar_Access y Start Temporizador = "424" en tiempo de ejecución: Se requiere un objeto.
Error 5) corresponde a la macro Desconectar_Access = "424" en tiempo de ejecución: se requiere un objeto.
Al fin termine, pero considere necesario transcribirte todo el código para que de favor si lo puedes revisar y, con tus conocimientos y experiencia me puedas a apoyar a corregirlos a fin de que se pueda ejecutar satisfactoriamente los...
1 respuesta
Respuesta de Juan Carlos González Chavarría
1