1. Con este código puedes exportar una consulta de Access a Excel con VBA.
  2. Crea la consulta que desees exportar a Excel en Access
  3. Agrega un nuevo módulo de VBA
  4. Copia este código
  5. Asigna a un botón en su código VBA la función CrearExcel

Y te debe exportar el resultado de tu consulta a un nuevo libro de Excel

 

 

Sub CraerExcel() 'Entre las comillas ingres el nombre de tu consulta ExportarExcel "aqui_el_nombre_de_tu_consulta" End Sub  Sub ExportarExcel(ParamArray nombresQueries() As Variant) Dim objXL As Object Dim boolXL As Boolean Dim objActiveWkb As Object Dim hoja As Object Dim rst As Recordset Dim fld As Field Dim i As Integer Dim nom As String Dim fila As Integer, columna As Integer     Set objXL = CreateObject("Excel.Application")         boolXL = True     objXL.Application.Visible = True     objXL.Application.Workbooks.Add     Set objActiveWkb = objXL.Application.ActiveWorkbook     For i = 0 To UBound(nombresQueries())         'añadimos una hoja nueva por         'cada consulta que se haya pasado         'como parámetro         Set hoja = objXL.Sheets.Add 'appExcel.Sheets.Add         nom = nombresQueries(i)         'si el nombre de la consulta es         '>31 caracteres dara error así que         'lo recortamos         If Len(nom) > 31 Then             nom = Left(nom, 31)         End If         '... y le damos nombre a la hoja         hoja.Name = nombresQueries(i)         'abrimos la consulta         Set rst = CurrentDb.OpenRecordset(nombresQueries(i))         'ponemos nombre a las columnas de las hojas         'igual que el nombre de los campos de la consulta         fila = 1         columna = 1         For Each fld In rst.Fields             hoja.cells(fila, columna) = fld.Name             columna = columna + 1         Next         hoja.cells(1, 1).Value = "# Caja"         hoja.cells(1, 4).Value = "Marca"         hoja.cells(1, 6).Value = "País Origen"         hoja.cells(1, 4).Value = "Marca"                  '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                 hoja.cells(fila, columna) = fld.Value                 columna = columna + 1             Next             columna = 1             fila = fila + 1             rst.MoveNext         Wend         rst.Close     Next     Set objXL = Nothing 'appExcel = Nothing End Sub

 

0Shares

Leave a Comment

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *