Error ejecución macro
Actualmente tengo este problema quiero exportar ciertos datos de acrchivo de access a excel pero al momento de su ejecución marca error 424 "se requiere objeto" de favor me puedes apoyar, en líneas abajo te indico el error en negritas, de antemano gracias.
Sub Conectar_Access()
'
' Conectar_Access Macro
' Macro grabada el 24/02/2009 por Miguel
'
' Acceso directo: CTRL+m
'
End Sub
Public Sub cmdConectar_Access()
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim Conex As ADODB.Connection
Dim recSet As ADODB.Recordset
Dim strDB, strSQL As String
Dim strTabla As String
Dim IngTablas As Long
Dim i As Long
strDB = ThisWorkbook.Path & "\" & "AdministraciónCarterabd1.mdb"
' Nombre de los archivos de access
' construyo la primera cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, Plazo " & _
"FROM 4FormularioResumenMinistraciónMensual ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
For Each Campo In rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
xls.ActiveSheet.Cells(3, 3) = Campo.Plazo
' construyo la segunda cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, FechaMinistración " & _
"FROM 3DetalleMinistración ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
xls.ActiveSheet.Cells(3, 4) = Campo.FechaInicial
' construyo la tercera cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, FechaMinistración " & _
"FROM 4ResumenMinistraciónMensual ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Range("J3:J26") = Campo.ImporteMinistrado
' construyo la cuarta cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, FechaMinistración " & _
"FROM 3FormularioDetalleMinistración ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
' construyo la quinta cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, FechaMinistración " & _
"FROM 5FormularioResumenAmortizaciónMensual ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
' construyo la sexta cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, Mes " & _
"FROM 5ResumenAmortizaciónMensual ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.ActiveSheet.Range("K3:K26") = Campo.ImportePago
' construyo la septima cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo " & _
"FROM 4FormularioDetalleAmortización ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
' 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()
Dim ruta As String
Dim basededatos As String
' ruta
ruta = ThisWorkbook.Path
basededatos = " AdministraciónCarterabd1.mdb "
Conex.Open ("Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ruta & "\" & basededatos)
' abrir el libro ExportaraExcel
strLibro = CurrentProject.Path & "\TabAmort.xls.xls"
xls.Workbooks.Open (strLibro)
' visible o no
xls.Visible = False ' o false
' activo la hoja 4 de excel denominda "TabAmort"
xls.Worksheets("\TabAmort.xls").Activate
' consulta 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.Fields.Count
For i = 0 To IngCampos - 1
ActiveSheet.Cells(1, i + 1).Value = recSet.Fields(i).Name
Next
End Sub
Sub Desconectar_Access()
' Desconectar
recSet.Close: Set recSet = Nothing
End Sub
Sub Conectar_Access()
'
' Conectar_Access Macro
' Macro grabada el 24/02/2009 por Miguel
'
' Acceso directo: CTRL+m
'
End Sub
Public Sub cmdConectar_Access()
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim Conex As ADODB.Connection
Dim recSet As ADODB.Recordset
Dim strDB, strSQL As String
Dim strTabla As String
Dim IngTablas As Long
Dim i As Long
strDB = ThisWorkbook.Path & "\" & "AdministraciónCarterabd1.mdb"
' Nombre de los archivos de access
' construyo la primera cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, Plazo " & _
"FROM 4FormularioResumenMinistraciónMensual ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
For Each Campo In rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
xls.ActiveSheet.Cells(3, 3) = Campo.Plazo
' construyo la segunda cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, FechaMinistración " & _
"FROM 3DetalleMinistración ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
xls.ActiveSheet.Cells(3, 4) = Campo.FechaInicial
' construyo la tercera cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, FechaMinistración " & _
"FROM 4ResumenMinistraciónMensual ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Range("J3:J26") = Campo.ImporteMinistrado
' construyo la cuarta cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, FechaMinistración " & _
"FROM 3FormularioDetalleMinistración ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
' construyo la quinta cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, FechaMinistración " & _
"FROM 5FormularioResumenAmortizaciónMensual ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
' construyo la sexta cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo, Mes " & _
"FROM 5ResumenAmortizaciónMensual ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.ActiveSheet.Range("K3:K26") = Campo.ImportePago
' construyo la septima cadena de la SELECT
strSQL = "SELECT NoControl, CréditoNo " & _
"FROM 4FormularioDetalleAmortización ORDER BY NoControl"
xls.ActiveSheet.Range("A1:R26").Select
rst.Fields
xls.ActiveSheet.Cells(3, 1) = Campo.NoControl
xls.ActiveSheet.Cells(3, 2) = Campo.CréditoNo
' 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()
Dim ruta As String
Dim basededatos As String
' ruta
ruta = ThisWorkbook.Path
basededatos = " AdministraciónCarterabd1.mdb "
Conex.Open ("Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ruta & "\" & basededatos)
' abrir el libro ExportaraExcel
strLibro = CurrentProject.Path & "\TabAmort.xls.xls"
xls.Workbooks.Open (strLibro)
' visible o no
xls.Visible = False ' o false
' activo la hoja 4 de excel denominda "TabAmort"
xls.Worksheets("\TabAmort.xls").Activate
' consulta 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.Fields.Count
For i = 0 To IngCampos - 1
ActiveSheet.Cells(1, i + 1).Value = recSet.Fields(i).Name
Next
End Sub
Sub Desconectar_Access()
' Desconectar
recSet.Close: Set recSet = Nothing
End Sub
1 respuesta
Respuesta de Roberto Alvarado
1