In diesem Tutorial werden die Möglichkeiten zum Importieren von Daten aus Excel in eine Access-Tabelle und zum Exportieren von Access-Objekten (Abfragen, Berichte, Tabellen oder Formulare) nach Excel behandelt.
Excel-Datei in Access importieren
Um eine Excel-Datei in Access zu importieren, verwenden Sie die acImport Option von DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:\Temp\Book1.xlsx", True
Oder du kannst verwenden DoCmd.TransferText So importieren Sie eine CSV-Datei:
DoCmd.TransferText acLinkDelim, , "Table1", "C:\Temp\Book1.xlsx", True
Importieren von Excel in Access-Funktion
Mit dieser Funktion können Sie eine Excel- oder CSV-Datei in eine Access Table importieren:
Öffentliche Funktion ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean ' Verwendungsbeispiel: Aufruf von ImportFile ("Select an Excel File", "Excel Files", "*.xlsx", "C:\" , True ,True, "ExcelImportTest", True, True,false,True) Bei Fehler GoTo err_handler If (Right(Filename, 3) = "xls") Or ((Right(Filename, 4) = "xlsx")) Then DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If (Right(Filename, 3) = "csv") Then DoCmd.TransferText acLinkDelim, , TableName, Filename, True Excel-Tabelle existiert bereits… und lösche sie wenn ja If ObjectExists("Table", TableName) = True Then DropTable (TableName) Set colWorksheets = Nothing Exit Function err_handler: If (Err.Number = 3086 Or Err.Number = 3274 Or Err. Number = 3073) And errCount < 3 Then errCount = errCount + 1 ElseIf Err.Number = 3127 Then MsgBox "Die Felder in allen Registerkarten sind gleich. Bitte stellen Sie sicher, dass jedes Blatt hat die genauen Spaltennamen, wenn Sie mehrere importieren möchten", vbCritical, "MultiSheets nicht identisch" ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number & " - " & Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function
Sie können die Funktion wie folgt aufrufen:
Private Sub ImportFile_Example() Call VBA_Access_ImportExport.ImportFile("C:\Temp\Book1.xlsx", True, "Imported_Table_1") End Sub
Greifen Sie auf den VBA-Export in eine neue Excel-Datei zu
Um ein Access-Objekt in eine neue Excel-Datei zu exportieren, verwenden Sie die DoCmd.OutputTo Methode oder die DoCmd.TransferSpreadsheet-Methode:
Abfrage nach Excel exportieren
Diese VBA-Codezeile exportiert eine Abfrage mit DoCmd.OutputTo nach Excel:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:\temp\ExportedQuery.xls"
Oder Sie können stattdessen die DoCmd.TransferSpreadsheet-Methode verwenden:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:\temp\ExportedQuery.xls", True
Notiz: Dieser Code wird in das XLSX-Format exportiert. Stattdessen können Sie die Argumente aktualisieren, um stattdessen in ein CSV- oder XLS-Dateiformat zu exportieren (z. acFormatXLSX zu acFormatXLS).
Bericht nach Excel exportieren
Diese Codezeile exportiert einen Bericht mit DoCmd.OutputTo nach Excel:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c:\temp\ExportedReport.xls"
Oder Sie können stattdessen die DoCmd.TransferSpreadsheet-Methode verwenden:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:\temp\ExportedReport.xls", True
Tabelle nach Excel exportieren
Diese Codezeile exportiert eine Tabelle mit DoCmd.OutputTo nach Excel:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:\temp\ExportedTable.xls"
Oder Sie können stattdessen die DoCmd.TransferSpreadsheet-Methode verwenden:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:\temp\ExportedTable.xls", True
Formular nach Excel exportieren
Diese Codezeile exportiert ein Formular mit DoCmd.OutputTo nach Excel:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:\temp\ExportedForm.xls"
Oder Sie können stattdessen die DoCmd.TransferSpreadsheet-Methode verwenden:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:\temp\ExportedForm.xls", True
Export nach Excel-Funktionen
Diese einzeiligen Befehle eignen sich hervorragend zum Exportieren in eine neue Excel-Datei. Sie können jedoch nicht in eine vorhandene Arbeitsmappe exportieren. Im Folgenden stellen wir Ihnen Funktionen vor, mit denen Sie Ihren Export an eine vorhandene Excel-Datei anhängen können.
Darunter haben wir einige zusätzliche Funktionen zum Exportieren in neue Excel-Dateien aufgenommen, einschließlich Fehlerbehandlung und mehr.
In vorhandene Excel-Datei exportieren
Die obigen Codebeispiele eignen sich hervorragend zum Exportieren von Access-Objekten in eine neue Excel-Datei. Sie können jedoch nicht in eine vorhandene Arbeitsmappe exportieren.
Um Access-Objekte in eine vorhandene Excel-Arbeitsmappe zu exportieren, haben wir die folgende Funktion erstellt:
Öffentliche Funktion AppendToExcel(strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String) 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 Select If rst.RecordCount = 0 Then MsgBox "Keine Datensätze zu exportieren .", vbInformation, GetDBTitle Else On Error Resume Next Set ApXL = GetObject(, "Excel.Application") If Err.Number 0 Then Set ApXL = CreateObject("Excel.Application") End If Err.Clear ApXL.Visible = False Setze xlWBk = ApXL.Workbooks.Open(strFil eName) Set xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left(strSheetName, 31) xlWSh.Range("A1").Select Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount). Name ApXL.ActiveCell.Offset(0, 1).Select intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range("A2").CopyFromRecordset rst With ApXL .Range("A1").Select .Range(.Selection, .Selection.End(xlToRight)).Select .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection. .Borders.LineStyle = xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.Wrap.CActiveShet = Fals .EntireColumn.AutoFit xlWSh.Range("A1").Select .Visible = True End With 'xlWB.Close True 'Set xlWB = Nothing 'ApXL.Quit 'Set ApXL = Nothing End If End Function
Sie können die Funktion wie folgt verwenden:
Private Sub AppendToExcel_Example() Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet", "C:\Temp\Test.xlsx") End Sub
Beachten Sie, dass Sie aufgefordert werden, Folgendes zu definieren:
- Was soll ausgegeben werden? Tabelle, Bericht, Abfrage oder Formular
- Objektname
- Name des Ausgabeblatts
- Pfad und Name der Ausgabedatei.
SQL-Abfrage nach Excel exportieren
Stattdessen können Sie eine SQL-Abfrage mit einer ähnlichen Funktion nach Excel exportieren:
Öffentliche Funktion AppendToExcelSQLStatemet(strsql As String, strSheetName As String, strFileName As String) Dim strQueryName As String Dim ApXL As Excel.Application Dim xlWBk As Excel.Workbook Dim xlWSh As Excel.Worksheet Dim intCount As Integer 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" If ObjectExists("Query", strQueryName) Then CurrentDb.Query QueryDefs.Delete End If Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql) Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Then MsgBox "Keine zu exportierenden Datensätze.", vbInformation, GetDBTitle Else Weiter Set . On Error Resume 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.Blatt s.Add xlWSh.Name = Left(strSheetName, 31) xlWSh.Range("A1").Select Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount).Name ApXL.ActiveCell.Offset( 0, 1).Select intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range("A2").CopyFromRecordset rst With ApXL .Range("A1").Select .Range(.Selection, .Selection.End(xlToRight) ).Select .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle = xlNone .Selection.AutoFilter .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.RtireCo ("A1").Select .Visible = True End With 'xlWB.Close True 'Set xlWB = Nothing 'ApXL.Quit 'Set ApXL = Nothing End If End Function
So genannt:
Private Sub AppendToExcelSQLStatemet_Example() Call VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASheet", "C:\Temp\Test.xlsx") End Sub
Wo Sie zur Eingabe aufgefordert werden:
- SQL-Abfrage
- Name des Ausgabeblatts
- Pfad und Name der Ausgabedatei.
Funktion zum Exportieren in eine neue Excel-Datei
Mit diesen Funktionen können Sie Access-Objekte in eine neue Excel-Arbeitsmappe exportieren. Sie finden sie möglicherweise nützlicher als die einfachen einzelnen Zeilen am oberen Rand des Dokuments.
Öffentliche Funktion ExportToExcel(strObjectType As String, strObjectName As String, Optional strSheetName As String, Optional strFileName As String) 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 Bei Fehler GoTo ExportToExcel_Err DoCmd.Hourglass True 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 Select If rst.RecordCount = 0 Then MsgBox "No zu exportierende Datensätze.", vbInformation, GetDBTitle DoCmd.Hourglass False Else On Error Resume Next Set ApXL = GetObject(, "Excel.Application") If Err.Number 0 Then Set ApXL = CreateObject("Excel.Application") End If Irren. Clear On Error GoTo ExportToExcel_Err Set xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Set xlWSh = xlWBk.Worksheets("Sheet1") If Len(strSheetName) > 0 Then xlWSh.Name = Left(strSheetName, 31) End If xlWSh .Range("A1").Select Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount).Name ApXL.ActiveCell.Offset(0, 1).Select intCount = intCount + 1 Loop rst. MoveFirst xlWSh.Range("A2").CopyFromRecordset rst With ApXL .Range("A1").Select .Range(.Selection, .Selection.End(xlToRight)).Select .Selection.Interior.Pattern = xlSolid .Selection. Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle = xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.Entire.Row. B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range("A1").Select .Visible = True End Wi th retry: If FileExists(strFileName) Then Kill strFileName End If If strFileName "" Then xlWBk.SaveAs strFileName, FileFormat:=56 End If rst.Close Set rst = Nothing DoCmd.Hourglass False End If ExportToExcel_Exit: DoCmd.Hourglass False Exit Function ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Sanduhr False Resume ExportToExcel_Exit End Function
Die Funktion kann wie folgt aufgerufen werden:
Private Sub ExportToExcel_Example() Aufruf von VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet") End Sub
