Consulta y lectura de Excel con ADO

Question

Hola Buenas,

 Veran me estoy volviendo loco intentando descubrir por que se me queda en bucle  y no devuelve la consulta la siguiente macro (no consigue pasar del loop en la depuracion) alguien me puede ayudar.

Sub leer_fichero_excel()
'Ocultamos el procedimiento
Application.ScreenUpdating = False
'Si hay errores, que siga
On Error Resume Next
'Definimos las variables:
'indicamos la ruta del fichero donde nos conectaremos,
fichero = Application.GetOpenFilename("Archivo , xls.*", , "SELECCIONAR ARCHIVO.")
'Creamos el objeto conexión
Set Conn = ADODB.Connection
Conn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & fichero
'Creamos el objeto recordset
Set rs = ADODB.Recordset
'Seleccionamos los datos
Sql = "SELECT * FROM [Cabeceras$A1:Y17]"
'Escribimos los datos
rs.Open Sql, Conn, adOpenStatic, adLockOptimistic
'Traemos los datos, para lo cual
'comenzamos con los encabezados,
'y los escribiremos a partir de la celda A5
Range("A5").Select
ActiveCell = rs.Fields.Item(0).Name
ActiveCell.Offset(0, 1) = rs.Fields.Item(1).Name
ActiveCell.Offset(0, 2) = rs.Fields.Item(2).Name
ActiveCell.Offset(0, 3) = rs.Fields.Item(3).Name
ActiveCell.Offset(0, 4) = rs.Fields.Item(4).Name
ActiveCell.Offset(0, 5) = rs.Fields.Item(5).Name
ActiveCell.Offset(0, 6) = rs.Fields.Item(6).Name
ActiveCell.Offset(0, 7) = rs.Fields.Item(7).Name
ActiveCell.Offset(0, 8) = rs.Fields.Item(8).Name
ActiveCell.Offset(0, 9) = rs.Fields.Item(13).Name
ActiveCell.Offset(0, 10) = rs.Fields.Item(14).Name
ActiveCell.Offset(0, 11) = rs.Fields.Item(15).Name
ActiveCell.Offset(0, 12) = rs.Fields.Item(17).Name
ActiveCell.Offset(0, 13) = rs.Fields.Item(18).Name
ActiveCell.Offset(0, 14) = rs.Fields.Item(21).Name
ActiveCell.Offset(0, 15) = rs.Fields.Item(22).Name
ActiveCell.Offset(0, 16) = rs.Fields.Item(23).Name
ActiveCell.Offset(0, 17) = rs.Fields.Item(24).Name
'ponemos en negrita los encabezados
Range("A5:Y5").Font.Bold = True
'Ahora seguimos con los datos, hasta acabar
'con los datos que nos devuelve la consulta

Do While Not rs.EOF

ActiveCell.Offset(1, 0) = rs(0)

ActiveCell.Offset(1, 1) = rs(1)

ActiveCell.Offset(1, 2) = rs(2)

ActiveCell.Offset(1, 3) = rs(3)

ActiveCell.Offset(1, 4) = rs(4)

ActiveCell.Offset(1, 5) = rs(5)

ActiveCell.Offset(1, 6) = rs(6)

ActiveCell.Offset(1, 7) = rs(7)

ActiveCell.Offset(1, 8) = rs(8)

ActiveCell.Offset(1, 9) = rs(13)

ActiveCell.Offset(1, 10) = rs(14)

ActiveCell.Offset(1, 11) = rs(15)

ActiveCell.Offset(1, 12) = rs(17)

ActiveCell.Offset(1, 13) = rs(18)

ActiveCell.Offset(1, 14) = rs(21)

ActiveCell.Offset(1, 15) = rs(22)

ActiveCell.Offset(1, 16) = rs(23)

ActiveCell.Offset(1, 17) = rs(24)

'nos movemos al siguiente registro

rs.MoveNext

'bajamos una fila

ActiveCell.Offset(1, 0).Select

Loop

'cerramos y limpiamos los objetos
rs.Close
Conn.Close
Set rs = Nothing
Set Conn = Nothing
'Mostramos el procedimiento
Application.ScreenUpdating = True
End Sub

---

Cristhian

Answer 1

hola

pero estas progtramando con ADO, no con ADO.NET, la aplciacion estas programada con .net ?

si es asi porque no suas ado.net en lugar del ado que suarias en una aplciacion VB6

 

 

Cómo usar ADO.NET para recuperar y modificar registros en un libro de Excel con Visual Basic .NET

 

Connection strings for Excel

Connection strings for Excel 2007

 

Read Data from Excel using OLEDB in VB.NET 2005

como veras alli se usa ado.net y este es mas simple de trabjar porque puedes cargarlo en un datatable y trabajarlo a gusto

saludos

---

Leandro Tuttini

Blog
Buenos Aires
Argentina

Answer 2

"cristhian_jose" escribió:

> Veran me estoy volviendo loco intentando descubrir por que se me queda
> en bucle  y no devuelve la consulta la siguiente macro (no consigue
> pasar del loop en la depuracion) alguien me puede ayudar.

Hola:

En principio entiendo que cuando se llegue al final del conjunto de registros (Recordset), la ejecución del código debe de salir del bucle Do ... Loop. Pero como el código fuente que has expuesto, a mi entender presenta numerosos errores de codificación, lo primero que te aconsejaría sería que eliminaras del código la siguiente línea:

    'Si hay errores, que siga
    'On Error Resume Next

y la cambiases por ésta otra:

    ' Si hay errores, mostramos un mensaje de error
    On Error GoTo ErrorLeerFicheroExcel

Aparte, veo que indicas:

  'Definimos las variables:

y no veo por ninguna parte que hayas definido las oportunas variables mediante la instrucción «Dim». :-)

Prueba el código tal cual te indico a continuación:

Sub leer_fichero_excel()

    'Ocultamos el procedimiento
    Application.ScreenUpdating = False

    ' Si hay errores, mostramos un mensaje de error
    On Error GoTo ErrorLeerFicheroExcel
   
    'Definimos las variables:

    'indicamos la ruta del fichero donde nos conectaremos,
    Dim fichero As String
    fichero = Application.GetOpenFilename("Archivo , xls.*", , "SELECCIONAR ARCHIVO.")

    'Creamos el objeto conexión
    Dim Conn As ADODB.Connection
    Set Conn = New ADODB.Connection
    Conn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & fichero

    'Creamos el objeto recordset
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset

    'Seleccionamos los datos
    Dim sql As String
    sql = "SELECT * FROM [Cabeceras$A1:Y17]"

    'Escribimos los datos
    rs.Open sql, Conn, adOpenStatic, adLockOptimistic, adCmdText

    'Traemos los datos, para lo cual
    'comenzamos con los encabezados,
    'y los escribiremos a partir de la celda A5
    Range("A5").Select
    ActiveCell = rs.Fields.Item(0).Name
    ActiveCell.Offset(0, 1) = rs.Fields.Item(1).Name
    ActiveCell.Offset(0, 2) = rs.Fields.Item(2).Name
    ActiveCell.Offset(0, 3) = rs.Fields.Item(3).Name
    ActiveCell.Offset(0, 4) = rs.Fields.Item(4).Name
    ActiveCell.Offset(0, 5) = rs.Fields.Item(5).Name
    ActiveCell.Offset(0, 6) = rs.Fields.Item(6).Name
    ActiveCell.Offset(0, 7) = rs.Fields.Item(7).Name
    ActiveCell.Offset(0, 8) = rs.Fields.Item(8).Name
    ActiveCell.Offset(0, 9) = rs.Fields.Item(13).Name
    ActiveCell.Offset(0, 10) = rs.Fields.Item(14).Name
    ActiveCell.Offset(0, 11) = rs.Fields.Item(15).Name
    ActiveCell.Offset(0, 12) = rs.Fields.Item(17).Name
    ActiveCell.Offset(0, 13) = rs.Fields.Item(18).Name
    ActiveCell.Offset(0, 14) = rs.Fields.Item(21).Name
    ActiveCell.Offset(0, 15) = rs.Fields.Item(22).Name
    ActiveCell.Offset(0, 16) = rs.Fields.Item(23).Name
    ActiveCell.Offset(0, 17) = rs.Fields.Item(24).Name

    'ponemos en negrita los encabezados
    Range("A5:Y5").Font.Bold = True

    'Ahora seguimos con los datos, hasta acabar
    'con los datos que nos devuelve la consulta

    Do While Not rs.EOF
        ActiveCell.Offset(1, 0) = rs(0)
        ActiveCell.Offset(1, 1) = rs(1)
        ActiveCell.Offset(1, 2) = rs(2)
        ActiveCell.Offset(1, 3) = rs(3)
        ActiveCell.Offset(1, 4) = rs(4)
        ActiveCell.Offset(1, 5) = rs(5)
        ActiveCell.Offset(1, 6) = rs(6)
        ActiveCell.Offset(1, 7) = rs(7)
        ActiveCell.Offset(1, 8) = rs(8)
        ActiveCell.Offset(1, 9) = rs(13)
        ActiveCell.Offset(1, 10) = rs(14)
        ActiveCell.Offset(1, 11) = rs(15)
        ActiveCell.Offset(1, 12) = rs(17)
        ActiveCell.Offset(1, 13) = rs(18)
        ActiveCell.Offset(1, 14) = rs(21)
        ActiveCell.Offset(1, 15) = rs(22)
        ActiveCell.Offset(1, 16) = rs(23)
        ActiveCell.Offset(1, 17) = rs(24)
       
        'nos movemos al siguiente registro
        rs.MoveNext
   
        'bajamos una fila
        ActiveCell.Offset(1, 0).Select
    Loop

ErrorLeerFicheroExcel:
    'cerramos y limpiamos los objetos
    If (Not (rs Is Nothing) And (rs.State = 1)) Then _
        rs.Close
       
    Set rs = Nothing
       
    If (Not (Conn Is Nothing) And (Conn.State = 1)) Then _
        Conn.Close
       
    Set Conn = Nothing

    'Mostramos el procedimiento
    Application.ScreenUpdating = True
   
    ' si procede, mostramos el mensaje de error
    If (Err.Number <> 0) Then _
        MsgBox Err.Description, vbCritical, "Leer fichero de Excel"
   
End Sub

Mira a ver si en principio obtienes algún error.

Un saludo

 

---

Enrique Martínez
  [MS MVP - VB]

Answer 3

Nuchas gracias

Pero me da el siguiente error: error de compilacion no se a definido el tipo definido por el usuario, aun asi no es del todo util ya que la idea es la siguiente: tengo un libro excel con macros y con poco peso y aparte una carpeta con distintos libros y hojas, lo que pretendo es ya que la primera hoja de cada libro en la carpeta tienen los mismos encabezados, traer los datos de 6 libros de la carpeta a mi excel con macros o sea que cada primera hoja de los seis libros se leen en una hoja de un libro.

¿Porque lectura? porque si importo el peso de la hoja seria elevado y tedioso o tendria que crear una macro para limpiar o no guardar la informacion, si leo y utilizo las macros de filtros podre extraer lo necesario, extraerla y no modificar la informacion real.

Con esta formula ADO puedo traer la informacion rapida y eficazmente, incluyendo la eleccion de las columnas que quiero pero solo de un libro la primera hoja, ¿como puedo realizarlo?

 Gracias anticipadas

---

Cristhian

Answer 4

"cristhian_jose" escribió:

> Pero me da el siguiente error: error de compilacion no se a
> definido el tipo definido por el usuario,

¿Y en qué parte del código obtienes ese error? Si por casualidad es en ésta línea

     'Creamos el objeto conexión
     Dim Conn As ADODB.Connection

asegúrate de tener referenciada en tu libro de Excel de Macros la biblioteca COM «Microsoft ActiveX Data Objects 2.x Library», si tu intención es utilizar los objetos de ADO clásicos. La «x» se corresponderá con la versión de la citada biblioteca que tengas instalada en tu equipo.

> ¿como puedo realizarlo?

Para leer datos de un libro de Excel de una manera fácil y eficaz, puedes utilizar la biblioteca de ADO. Lo mismo te resulta útil el siguiente artículo:

Trabajar con ADO, DAO y Excel

 

---

Enrique Martínez
  [MS MVP - VB]

Answer 5

Perdona la tardanza pero la salud me impidio, ver los mensajes antes, ante todo muchas gracias Enrique por tu colaboracion, estoy estudiando el articulo de Ado y haber si conseguimos algo.

 

Os cuento y os agradeceria si opteneis alguna informacion relativa a la rutina que quiero establecer.

 

 

 

---

Cristhian

Answer 6

Hola despues de un tiempo tratando de hacerla funcionar, lo consegui solo que el problema es que lo realiza con un libro hacia otro libro y yo necesito que lo haga de 6 libros a un libro o sea traer los datos que tienen el mismo formato de seis hojas a una listadola sin pisar datos. ¿Podeis ayudarme? os envio de nuevo lo que tengo con ayuda de Enrique 

Sub leer_fichero_excel()
 
    'Ocultamos el procedimiento
     Application.ScreenUpdating = False
 
    'Si hay errores, mostramos un mensaje de error
     On Error GoTo ErrorLeerFicheroExcel
    
    'Indicamos la ruta del fichero donde nos conectaremos,
     Dim fichero As String
     fichero = Application.GetOpenFilename("Archivo , xls.*", , "SELECCIONAR ARCHIVO.")
 
    'Creamos el objeto conexión
     Dim Conn As New ADODB.Connection
     Set Conn = New ADODB.Connection
     Conn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & fichero
 
    'Creamos el objeto recordset
     Dim rs As ADODB.Recordset
     Set rs = New ADODB.Recordset
 
    'Seleccionamos los datos
     Dim sql As String
     sql = "SELECT * FROM [Cabeceras$A1:Y125]"
 
    'Escribimos los datos
     rs.Open sql, Conn, adOpenStatic, adLockOptimistic, adCmdText
 
    'Traemos los datos, para lo cual
     'comenzamos con los encabezados,
     'y los escribiremos a partir de la celda B5
     Range("B5").Select
     ActiveCell = rs.Fields.Item(0).Name
     ActiveCell.Offset(0, 1) = rs.Fields.Item(1).Name
     ActiveCell.Offset(0, 2) = rs.Fields.Item(2).Name
     ActiveCell.Offset(0, 3) = rs.Fields.Item(3).Name
     ActiveCell.Offset(0, 4) = rs.Fields.Item(4).Name
     ActiveCell.Offset(0, 5) = rs.Fields.Item(5).Name
     ActiveCell.Offset(0, 6) = rs.Fields.Item(6).Name
     ActiveCell.Offset(0, 7) = rs.Fields.Item(7).Name
     ActiveCell.Offset(0, 8) = rs.Fields.Item(8).Name
     ActiveCell.Offset(0, 9) = rs.Fields.Item(13).Name
     ActiveCell.Offset(0, 10) = rs.Fields.Item(14).Name
     ActiveCell.Offset(0, 11) = rs.Fields.Item(15).Name
     ActiveCell.Offset(0, 12) = rs.Fields.Item(17).Name
     ActiveCell.Offset(0, 13) = rs.Fields.Item(18).Name
     ActiveCell.Offset(0, 18) = rs.Fields.Item(21).Name
     ActiveCell.Offset(0, 19) = rs.Fields.Item(22).Name
     ActiveCell.Offset(0, 20) = rs.Fields.Item(23).Name
               
    'ponemos en negrita los encabezados
     Range("A5:V5").Font.Bold = True
 
    'Ahora seguimos con los datos, hasta acabar
     'con los datos que nos devuelve la consulta (datos)
 
    Do While Not rs.EOF
         ActiveCell.Offset(1, 0) = rs(0)
         ActiveCell.Offset(1, 1) = rs(1)
         ActiveCell.Offset(1, 2) = rs(2)
         ActiveCell.Offset(1, 3) = rs(3)
         ActiveCell.Offset(1, 4) = rs(4)
         ActiveCell.Offset(1, 5) = rs(5)
         ActiveCell.Offset(1, 6) = rs(6)
         ActiveCell.Offset(1, 7) = rs(7)
         ActiveCell.Offset(1, 8) = rs(8)
         ActiveCell.Offset(1, 9) = rs(13)
         ActiveCell.Offset(1, 10) = rs(14)
         ActiveCell.Offset(1, 11) = rs(15)
         ActiveCell.Offset(1, 12) = rs(17)
         ActiveCell.Offset(1, 13) = rs(18)
         ActiveCell.Offset(1, 18) = rs(21)
         ActiveCell.Offset(1, 19) = rs(22)
         ActiveCell.Offset(1, 20) = rs(23)
                                  
        'nos movemos al siguiente registro
         rs.MoveNext
    
        'bajamos una fila
         ActiveCell.Offset(1, 0).Select
     Loop
 
ErrorLeerFicheroExcel:
     'cerramos y limpiamos los objetos
     If (Not (rs Is Nothing) And (rs.State = 1)) Then _
         rs.Close
        
    Set rs = Nothing
        
    If (Not (Conn Is Nothing) And (Conn.State = 1)) Then _
         Conn.Close
        
    Set Conn = Nothing
 
    'Mostramos el procedimiento
     Application.ScreenUpdating = True
    
    ' si procede, mostramos el mensaje de error
     If (Err.Number <> 0) Then _
         MsgBox Err.Description, vbCritical, "Leer fichero de Excel"
    
End Sub

 

---

Cristhian

Answer 7

"cristhian_jose" escribió:

> yo necesito que lo haga de 6 libros a un libro o sea traer los
> datos que tienen el mismo formato de seis hojas a una
> listadola sin pisar datos

Pues tendrás que ejecutar seis veces el procedimiento "leer_fichero_excel", eso sí, adaptándolo para que el procedimiento sepa de qué hoja de cálculo, o rango de celdas, tiene que leer los datos, salvo que los seis libros tenga una hoja de cálculo llamada Cabeceras y los datos estén en el rango A1:Y125.

  Sub leer_fichero_excel(ByVal rangoCeldas As String)

  End Sub

Ésta línea

>  sql = "SELECT * FROM [Cabeceras$A1:Y125]"
 
la tendrás que sustituir por la siguiente:

 sql = "SELECT * FROM [" & rangoCeldas " & "]"
 
Y al procedimiento lo llamarías de la siguiente manera:

  leer_fichero_excel "Cabeceras$A1:Y125"

NOTA: por si aún no te has dado cuenta, te comento que estás efectuando tus preguntas en el foro de ADO .NET, que poco tiene que ver con la biblioteca de ADO clásico, que es la que estás utilizando en tu código fuente. Si lo crees conveniente, mejor sería que efectuaras tus preguntas en alguno de los siguientes foros:

Lenguaje VB 5/6

Programación con Microsoft Office

 

---

Enrique Martínez
  [MS MVP - VB]