rem PASAR A EXCEL UNA TABLA O CONSULTA DE ACCESS
Dim rst As DAO.Recordset, _
strSQL As String
Rem pasa datos a excell
Dim objExcel As Object
Dim libro As Object
Const xlHairline = 1
Const xlMedium = -4138
Const xlThick = 4
Const xlThin = 2
Const xlWBATWorksheet = -4167
Set objExcel = CreateObject("Excel.Application")objExcel.Visible = True
Set libro = objExcel.Workbooks.Add
' creo un libro con una sola hoja
'libro.Workbooks.Add xlWBATWorksheet
strHoja = libro.ActiveSheet.Name
'libro.ActiveSheet.Name = " "
' construyo la cadena de la SELECT
strSQL = "SELECT * FROM [cuentas-2D] WHERE ANIO = '" & "2007" & "' "
' abro el recordset
PASAR A EXCEL UNA TABLA O CONSULTA DE ACCESS
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
Rem grabo la cabecera -----------------------------
'copiar rótulos
lngCampos = rst.Fields.Count
For i = 0 To lngCampos - 1
libro.ActiveSheet.Cells(1, (i + 1)).Value = rst.Fields(i).Name
Next
Rem ---------
rst.MoveFirst
N = 2
' si el recordset no está vacio
Do While rst.EOF = False
lngCampos = rst.Fields.Count
For i = 0 To lngCampos - 1
libro.ActiveSheet.Cells(N, i + 1).Value = rst.Fields(i).Value
Next
rst.MoveNext
N = N + 1
Loop
' ajusto el tamaño de las columnas
'libro.ActiveSheet.Range("A:Z").Select
libro.ActiveSheet.Columns(1, rst.Fields.Count).EntireColumn.AutoFit
'Range("").EntireColumn.AutoFit
'libro.Columns(1, rst.Fields.Count).EntireColumn.AutoFit
' Range("").EntireColumn.AutoFit
rst.Close
Crear cuenta