'*********************************************************
' ExportarAExcel
'
' Exporta a la hoja de un libro de excel existente la
' tabla, consulta o consulta sql que le pasemos en sus
' argumentos
'
' Argumentos
'   cadSQL: nombre de la tabla, consulta o sentencia SQL
'   libro: ruta completa del libro de excel
'   hoja: nombre de la hora en la que se quiere escribir
'
' Ejemplo de uso:
'
'   ExportarAExcel "SELECT * FROM Clientes", _
'                  "c:\libro1.xls", _
'                  "hoja1"
'
' Juan M. Afán de Ribera
' Julio/2002
'
Sub ExportarAExcel(cadSQL As String, _
                  libro As String, _
                  hoja As String)
   
Dim appExcel As Object 'Excel.Application
Dim rst As Object 'DAO.Recordset
Dim fld As Object 'DAO.Field
Dim fila As Integer
Dim columna As Integer

   ' abrimos excel, lo hacemos visible y abrimos el libro
   ' que nos interesa
   Set appExcel = CreateObject("Excel.Application")
   appExcel.Visible = True
   appExcel.Workbooks.Open Filename:=libro
   
   ' abrimos la tabla, consulta o cadena sql en un
   ' recordset
   Set rst = CurrentDb.OpenRecordset(cadSQL)
   
   ' ponemos nombre a las columnas de la hojaigual que el
   ' nombre de los campos de la consulta
   fila = 1
   columna = 1
   With appExcel.Sheets(hoja)
      .Select
      For Each fld In rst.Fields
         .Cells(fila, columna) = fld.Name
         columna = columna + 1
      Next
    
      ' después traspasamos el valor de los campos a las
      ' celdas de la hoja de excel
      fila = 2
      columna = 1
      While Not rst.EOF
         For Each fld In rst.Fields
            .Cells(fila, columna) = fld.Value
            columna = columna + 1
         Next
         columna = 1
         fila = fila + 1
         rst.MoveNext
      Wend
      
   .Name = cadSQL
   End With

   rst.Close
   
   ' activa estas dos lineas si quieres cerrar
   ' y guardar los cambios automáticamente
   
   'appExcel.ActiveWorkbook.Close True
   'appExcel.Quit
   
   Set appExcel = Nothing
   
End Sub
'*********************************************************