Acceda a VBA - Importación / Exportación de Excel - Consulta, informe, tabla y formularios

Este tutorial cubrirá las formas de importar datos de Excel a una tabla de Access y las formas de exportar objetos de Access (consultas, informes, tablas o formularios) a Excel.

Importar archivo de Excel a Access

Para importar un archivo de Excel a Access, use el acImportar opción de DoCmd.TransferSpreadsheet :

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True

O puedes usar DoCmd.TransferText para importar un archivo CSV:

DoCmd.TransferText acLinkDelim,, "Table1", "C: \ Temp \ Book1.xlsx", True

Importar Excel para acceder a la función

Esta función se puede utilizar para importar un archivo de Excel o un archivo CSV en una tabla de acceso:

Función pública ImportFile (nombre de archivo como cadena, HasFieldNames como booleano, TableName como cadena) como booleano 'Ejemplo de uso: llamar a ImportFile ("Seleccionar un archivo de Excel", "Archivos de Excel", "* .xlsx", "C: \", True , Verdadero, "ExcelImportTest", Verdadero, Verdadero, falso, Verdadero) En caso de error Ir a err_handler Si (Derecha (Nombre de archivo, 3) = "xls") O ((Derecha (Nombre de archivo, 4) = "xlsx")) Entonces DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If (Right (Filename, 3) = "csv") Then DoCmd.TransferText acLinkDelim, TableName, Filename, True End If Exit_Thing: 'Limpiar' Verifique si nuestro enlace está La tabla de Excel ya existe … y elimínela si es así Si ObjectExists ("Table", TableName) = True Then DropTable (TableName) Establecer colWorksheets = Nothing Función de salida err_handler: If (Err.Number = 3086 Or Err.Number = 3274 O Err. Number = 3073) And errCount <3 Entonces errCount = errCount + 1 ElseIf Err.Number = 3127 Then MsgBox "Los campos en todas las pestañas son iguales. Asegúrese de que cada hoja tiene los nombres de columna exactos si desea importar varias ", vbCritical," MultiSheets no idénticas "ImportFile = False Ir a Exit_Thing Else MsgBox Err.Number &" - ​​"& Err.Description ImportFile = False Ir a Exit_Thing Resume End If End Function

Puedes llamar a la función así:

Sub privado ImportFile_Example () Llamar a VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") End Sub

Acceda a la exportación de VBA a un nuevo archivo de Excel

Para exportar un objeto de Access a un nuevo archivo de Excel, use el DoCmd.OutputTo método o el Método DoCmd.TransferSpreadsheet:

Exportar consulta a Excel

Esta línea de código VBA exportará una consulta a Excel usando DoCmd.OutputTo:

DoCmd.OutputTo acOutputQuery, "Consulta1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"

O puede usar el método DoCmd.TransferSpreadsheet en su lugar:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True

Nota: Este código se exporta a formato XLSX. En su lugar, puede actualizar los argumentos para exportar a un formato de archivo CSV o XLS (p. Ej. acFormatXLSX para acFormatXLS).

Exportar informe a Excel

Esta línea de código exportará un informe a Excel usando DoCmd.OutputTo:

DoCmd.OutputTo acOutputReport, "Informe1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"

O puede usar el método DoCmd.TransferSpreadsheet en su lugar:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True

Exportar tabla a Excel

Esta línea de código exportará una tabla a Excel usando DoCmd.OutputTo:

DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"

O puede usar el método DoCmd.TransferSpreadsheet en su lugar:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True

Exportar formulario a Excel

Esta línea de código exportará un formulario a Excel usando DoCmd.OutputTo:

DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"

O puede usar el método DoCmd.TransferSpreadsheet en su lugar:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True

Exportar a funciones de Excel

Estos comandos de una línea funcionan muy bien para exportar a un nuevo archivo de Excel. Sin embargo, no podrán exportar a un libro de trabajo existente. En la siguiente sección presentamos funciones que le permiten agregar su exportación a un archivo Excel existente.

Debajo de eso, hemos incluido algunas funciones adicionales para exportar a nuevos archivos de Excel, incluido el manejo de errores y más.

Exportar a un archivo Excel existente

Los ejemplos de código anteriores funcionan muy bien para exportar objetos de Access a un nuevo archivo de Excel. Sin embargo, no podrán exportar a un libro de trabajo existente.

Para exportar objetos de Access a un libro de Excel existente, hemos creado la siguiente función:

Función pública AppendToExcel (strObjectType como cadena, strObjectName como cadena, strSheetName como cadena, strFileName como cadena) Dim rst As DAO.Recordset Dim ApXL As Excel.Application Dim xlWBk As Excel.Workbook Dim xlWSh As Excel.Worksheet Dim intCount As Integer Const xlToRight As Long = -4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset (strObjectName, dbOpenDynaset, dbSeeChanges) Case "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Seleccione If rst.RecordCount = 0 Then No MsgBoxed . ", vbInformation, GetDBTitle Else On Error Reanudar Siguiente Establecer ApXL = GetObject (," Excel.Application ") Si Err.Number 0 Entonces Establecer ApXL = CreateObject (" Excel.Application ") Finalizar Si Err.Clear ApXL.Visible = False Establezca xlWBk = ApXL.Workbooks.Open (strFil eName) Establezca xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Seleccione Hacer hasta intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Nombre ApXL.ActiveCell.Offset (0, 1) .Seleccione intCount = intCount + 1 Loop primero.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset primero Con ApXL .Range ("A1"). Seleccione .Range (.Selection, .Selection.End (xlToRight)) .Seleccione .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade.Borders = 0. xlNinguno .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Seleccione .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.WrapText = False. .EntireColumn.AutoFit xlWSh.Range ("A1"). Seleccione .Visible = True Finalizar con 'xlWB.Close True' Establecer xlWB = Nada 'ApXL.Quit' Establecer ApXL = Nada Finalizar si finaliza la función

Puedes usar la función de esta manera:

Private Sub AppendToExcel_Example () Llamar a VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub

Observe que se le pide que defina:

• ¿Qué Salida? Tabla, informe, consulta o formulario
• Nombre del objeto
• Nombre de la hoja de salida
• Ruta y nombre del archivo de salida.

Exportar consulta SQL a Excel

En su lugar, puede exportar una consulta SQL a Excel usando una función similar:

Función pública AppendToExcelSQLStatemet (strsql como cadena, strSheetName como cadena, strFileName como cadena) Dim strQueryName como cadena Dim ApXL como Excel.Application Dim xlWBk como Excel.Workbook Dim xlWSh como Excel.Worksheet Dim intCuenta como entero Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlVAlignCenter = -4108 Const xlContinuous As Long = 1 Dim qdf As DAO.QueryDef Dim rst As DAO.Recordset strQueryName = "tmpQueryToExportToExcel" Si ObjectExists ("Query", strQueryName.Query luego actual) End If Set qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Set rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Entonces MsgBox "No hay registros para exportar." ApXL = GetObject (, "Excel.Application") If Err.Number 0 Then Set ApXL = CreateObject ("Excel.Application") End If Err.Clear ApXL.Visible = False Set xlWBk = ApXL.Workbooks.Open (strFileName) Set xlWSh = xlWBk.Sheet s.Añadir xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Seleccione Do hasta intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset ( 0, 1) .Seleccione intCount = intCount + 1 Loop primero.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset primero con ApXL .Range ("A1"). Seleccione .Range (.Selection, .Selection.End (xlToRight) ) .Seleccione .Selección.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineSelloneStyle. .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Seleccione .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit.RangeW xl ("A1"). Seleccione .Visible = Verdadero Finalizar con 'xlWB.Close Verdadero' Establecer xlWB = Nada 'ApXL.Quit' Establecer ApXL = Nada Finalizar si Finalizar Función

Llamado así:

Private Sub AppendToExcelSQLStatemet_Example () Llamar a VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub

Donde se le pide que ingrese:

• Consulta SQL
• Nombre de la hoja de salida
• Ruta y nombre del archivo de salida.

Función para exportar a un nuevo archivo de Excel

Estas funciones le permiten exportar objetos de Access a un nuevo libro de Excel. Es posible que las encuentre más útiles que las simples líneas individuales en la parte superior del documento.

Función pública ExportToExcel (strObjectType como cadena, strObjectName como cadena, strSheetName opcional como cadena, strFileName opcional como cadena) Dim rst As DAO.Recordset Dim ApXL As Object Dim xlWBk As Object Dim xlWSh As Object Dim intCount As Integer Const xlToRight As Long = - 4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 On Error GoTo ExportToExcel_Err DoCmd.Hourglass True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordsetName, d , dbSeeChanges) Case "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Seleccione If rstx Then NocordsCogBount registros a exportar. ", vbInformation, GetDBTitle DoCmd.Hourglass False Else en caso de error Continuar Siguiente Establecer ApXL = GetObject (," Excel.Application ") If Err.Number 0 Entonces Establecer ApXL = CreateObject (" Excel.Application ") End If Errar. Borrar en caso de error Ir a ExportToExcel_Err Establecer xlWBk = ApXL.Workbooks.Añadir ApXL.Visible = False Establecer xlWSh = xlWBk.Worksheets ("Sheet1") If Len (strSheetName)> 0 Then xlWSh.Name = Left (strSheetName, 31) End If xlWSh .Range ("A1"). Seleccione Hacer hasta intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset (0, 1) .Seleccione intCount = intCount + 1 Loop primero. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset primero con ApXL .Range ("A1"). Seleccione .Range (.Selection, .Selection.End (xlToRight)) .Seleccione .Selection.Interior.Pattern = xlSolid .Selection. Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle = xlNone .Selection.AutoFilter .Cells.EntireColumnit.AutoFilit. B2 "). Seleccione .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Seleccione .Visible = True End Wi th reintento: Si FileExists (strFileName) Entonces Kill strFileName End If If strFileName "" Entonces xlWBk.SaveAs strFileName, FileFormat: = 56 End If rst.Close Set rst = Nothing DoCmd.Hourglass False End If ExportToExcel_Salir: DoCmd.Hourglass False Exit Función ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Reanudar ExportToExcel_Salir Función de fin

La función se puede llamar así:

Private Sub ExportToExcel_Example () Llame a VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet") End Sub