Share on facebook
Share on google
Share on twitter
Share on linkedin
Share on whatsapp
Exportar Tabla de Access a Excel con VBA

Exportar una consulta o una tabla de Access a Excel con VBA

 

    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
Share on facebook
Share on google
Share on twitter
Share on linkedin
Share on whatsapp

Posts Relacionados

0 Comments

No Comment.