Descargas, guías, trucos, gameplays...

miércoles, 13 de junio de 2012

Copiar datos desde otra hoja sin abrir el archivo base de datos, para proyectos VBA Excel



Ya vimos antes como copiar datos de otro archivo pero en ese método es necesario abrir el archivo fuente de datos para poder copiar lo que queremos. Lo siguiente es un código que encontre en la red, este permite copiar los datos sin necesidad de abrir el archivo.

En un archivo nuevo de Excel, insertar en la hoja un CommandButton.





Dar doble clic en el CommandButton, entonces copiar y pegar el siguiente código:
Private Sub CommandButton1_Click()
    'importar datos sin abrir archivo
    'dimensiones
    Dim datConnection As ADODB.Connection
    Dim recSet As ADODB.Recordset
    Dim recCampo As ADODB.Field
    Dim strDB, strSQL As String
    'Dim i As Long
    
    'ruta al archivo Excel (la base de datos). En este caso se llama fuente.xls
     strDB = ThisWorkbook.Path & Application.PathSeparator & "fuente.xls"  'archivo donde estan los datos que se quieren copiar
                                                                           'la ruta a la base de datos es la misma que este archivo
                                                                           'donde esta este código,
                                                                           'es decir que, para que este ejemplo funcione los dos
                                                                           'archivos deben estar a la par
                                                                           'por supuesto que pueden modificar esto si lo desean
    
    'conectar
    Set datConnection = New ADODB.Connection
    Set recSet = New ADODB.Recordset
    datConnection.Open "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & strDB
    
    'consulta SQL
     strSQL = "SELECT * FROM [Sheet1$A1:B5]" 'nombre de la hoja y rango donde estan los datos que se quieren copiar
    
    'abrimos el recordset
    recSet.Open strSQL, datConnection, adOpenStatic
    
    'copiar datos
    ActiveSheet.Cells(2, 1).CopyFromRecordset recSet 'celda de este libro donde se empiezan a pegar los datos
                                                     'empieza en la fila 2 porque despuès en la fila 1 se copiaran los
                                                     'encabezados de cada columna.
    
    'copiar encabezados de cada columna en la fila 1
    i = 1
    For Each recCampo In recSet.Fields
     ActiveSheet.Cells(1, i) = recCampo.Name: i = i + 1
    Next recCampo
    
    'desconectar (¡importante!)
    recSet.Close
    datConnection.Close
    
    'cerrar los objetos
    Set recSet = Nothing
    Set datConnection = Nothing
End Sub



Ahora al dar clic al botón vemos como se copian los datos sin necesidad de abrir el archivo base de datos:









8 comentarios:

  1. Hola Yo quiero algo asi pero que primero busque de acuerdo aun criterio y coloque los datos obtenidos , de acuerdo a ese criterio.

    ResponderEliminar
  2. Hola, se que este tema ya lleva varios años, pero me encontré con el código que justamente necesito y no puedo hacerlo funcionar. Al inicio me dice que "No se ha definido el tipo definido por el usuario" para todas las variables. Podrás ayudarme?. Gracias desde ya

    ResponderEliminar
    Respuestas
    1. Necesitaría que me envíes el archivo para revisarlo: miweb.ds@gmail.com

      Eliminar
    2. Si a alguien más le pasa esto, quizas sea lo que me pasó ami, estás leyendo un libro xlsx, prueba con libros xls, así si me funciona todo

      Eliminar
  3. Hola, como hago para realizarlo con un archivo .csv?

    ResponderEliminar
    Respuestas
    1. Buenas tardes:

      Esta rutina te sirve para importar un archivo xls. .xlsx o .csv, lo pasará a excel

      Sub ImportarDatos()
      Set origen = ActiveWorkbook
      Application.ScreenUpdating = False

      'Mensaje en la barra de estados
      Application.StatusBar = "Seleccione el fichero de datos"

      'Pedir el fichero con los datos
      'tomo el directorio donde se encuentra el libro
      ChDir ThisWorkbook.Path

      Set fd = Application.FileDialog(msoFileDialogOpen)
      fd.Title = "Seleccione el fichero con los datos"
      If fd.Show = -1 Then
      For Each ruta1 In fd.SelectedItems

      ' Ejecutar
      ruta = CurDir
      fd.Execute
      Next ruta1
      Else
      Application.StatusBar = "Cancelando la operación..."
      resultado = MsgBox("Ha cancelado la selección del fichero", vbCritical, "Operación Cancelada")
      If resultado = 1 Then
      resultado = a

      End If
      Application.StatusBar = False
      Exit Sub
      End If

      ' Poner en blanco el dialogo

      Set fd = Nothing

      'Aquí insertas tu código, puedes tenerlo en otra rutina y la llamas

      Call FormatearDatosImportados


      'Cierra el fichero .xls o .csv
      ActiveWorkbook.Close

      'Deja la barra de estado original
      Application.StatusBar = False
      End Sub

      Eliminar
  4. Alguien sabe como hacer funcionar el codigo para un archivo .xlsx, utilizando la busqueda de SQL y sin tener que abrir el archivo? el primer codigo solo funciona para xls

    ResponderEliminar
  5. Buenos dias su codigo esta excelente pero no lo puedo utilizar en archivos xlsm (habilitados para macros), le cambio las extenciones y me da error en datConnection.Open "DRIVER=Microsoft Excel Driver (fuente.xlsm);" & "DBQ=" & strDB,habra forma de adaptarlo,mi correo laalegria98@hotmail.com,gracias.

    ResponderEliminar