Deze zelfstudie behandelt de manieren om gegevens uit Excel te importeren in een Access-tabel en manieren om Access-objecten (query's, rapporten, tabellen of formulieren) naar Excel te exporteren.
Excel-bestand importeren in Access
Om een Excel-bestand in Access te importeren, gebruikt u de acImporteren optie van DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:\Temp\Book1.xlsx", True
Of u kunt gebruiken DoCmd.TransferText om een CSV-bestand te importeren:
DoCmd.TransferText acLinkDelim, , "Table1", "C:\Temp\Book1.xlsx", True
Excel importeren om toegang te krijgen tot functie
Deze functie kan worden gebruikt om een Excel-bestand of CSV-bestand in een Access Table te importeren:
Public Function ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean ' Voorbeeldgebruik: call ImportFile ("Selecteer een Excel-bestand", "Excel-bestanden", "*.xlsx", "C:\" , True ,True, "ExcelImportTest", True, True,false,True) Bij fout Ga naar 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 End If Exit_Thing: 'Opschonen' Controleer of onze gekoppelde in Excel-tabel bestaat al… en verwijder deze als dat zo is If ObjectExists("Table", TableName) = True Then DropTable (TableName) Set colWorksheets = Nothing Functie afsluiten err_handler: If (Err.Number = 3086 Of Err.Number = 3274 Of Err. Getal = 3073) En errCount < 3 Dan errCount = errCount + 1 ElseIf Err.Number = 3127 Dan MsgBox "De velden in alle tabbladen zijn hetzelfde. Zorg ervoor dat elk blad heeft de exacte kolomnamen als u meerdere", vbCritical, "MultiSheets not identiek" wilt importeren ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number & " - " & Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function
Je kunt de functie als volgt aanroepen:
Private Sub ImportFile_Example() Roep VBA_Access_ImportExport.ImportFile("C:\Temp\Book1.xlsx", True, "Imported_Table_1") End Sub
Toegang tot VBA-export naar nieuw Excel-bestand
Om een Access-object naar een nieuw Excel-bestand te exporteren, gebruikt u de DoCmd.OutputTo methode of de DoCmd.TransferSpreadsheet-methode:
Query exporteren naar Excel
Deze regel VBA-code exporteert een query naar Excel met DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:\temp\ExportedQuery.xls"
Of u kunt in plaats daarvan de DoCmd.TransferSpreadsheet-methode gebruiken:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:\temp\ExportedQuery.xls", True
Opmerking: Deze code wordt geëxporteerd naar XLSX-indeling. In plaats daarvan kunt u de argumenten bijwerken om in plaats daarvan naar een CSV- of XLS-bestandsindeling te exporteren (bijv. acFormatXLSX tot acFormatXLS).
Rapport exporteren naar Excel
Deze regel code exporteert een rapport naar Excel met DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c:\temp\ExportedReport.xls"
Of u kunt in plaats daarvan de DoCmd.TransferSpreadsheet-methode gebruiken:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:\temp\ExportedReport.xls", True
Tabel exporteren naar Excel
Deze regel code exporteert een tabel naar Excel met DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:\temp\ExportedTable.xls"
Of u kunt in plaats daarvan de DoCmd.TransferSpreadsheet-methode gebruiken:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:\temp\ExportedTable.xls", True
Formulier exporteren naar Excel
Deze regel code exporteert een formulier naar Excel met DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:\temp\ExportedForm.xls"
Of u kunt in plaats daarvan de DoCmd.TransferSpreadsheet-methode gebruiken:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:\temp\ExportedForm.xls", True
Exporteren naar Excel-functies
Deze éénregelige opdrachten werken prima om te exporteren naar een nieuw Excel-bestand. Ze kunnen echter niet exporteren naar een bestaande werkmap. In de onderstaande sectie introduceren we functies waarmee u uw export kunt toevoegen aan een bestaand Excel-bestand.
Daaronder hebben we enkele extra functies opgenomen om te exporteren naar nieuwe Excel-bestanden, inclusief foutafhandeling en meer.
Exporteren naar bestaand Excel-bestand
De bovenstaande codevoorbeelden werken uitstekend om Access-objecten naar een nieuw Excel-bestand te exporteren. Ze kunnen echter niet exporteren naar een bestaande werkmap.
Om Access-objecten naar een bestaande Excel-werkmap te exporteren, hebben we de volgende functie gemaakt:
Openbare functie AppendToExcel (strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String) Dim eerst als DAO.Recordset Dim ApXL As Excel.Application Dim xlWBk As Excel.Workbook Dim xlWSh As Excel.Werkblad Dim intCount xlToR Integer Const 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, dbOpenDynset, dbSeeChanges) "Form" Set rst = Forms(strObjectName).RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 records om te exporteren " .", vbInformation, GetDBTitle Anders Bij Fout Hervatten Volgende Set ApXL = GetObject(, "Excel.Application") If Err.Number 0 Stel vervolgens ApXL = CreateObject("Excel.Application") in End If Err.Clear ApXL.Visible = False Stel xlWBk = ApXL.Werkboeken.Open(strFil .) in eName) Set xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left(strSheetName, 31) xlWSh.Range("A1").Selecteer Doen tot intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount). Naam ApXL.ActiveCell.Offset(0, 1).Selecteer 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 .Selectie.Borders = xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.Wrapell =Wrapt .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
U kunt de functie als volgt gebruiken:
Private Sub AppendToExcel_Example() Roep VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBSheet", "C:\Temp\Test.xlsx") End Sub
Merk op dat u wordt gevraagd om te definiëren:
- Wat uit te voeren? Tabel, Rapport, Query of Formulier
- Objectnaam
- Naam uitvoerblad
- Pad en naam van uitvoerbestand.
SQL-query exporteren naar Excel
In plaats daarvan kunt u een SQL-query naar Excel exporteren met een vergelijkbare functie:
Publieke functie 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 xl108 Const As Long = xlBottom As Long = -4107 Const xlVAlignCenter = -4108 Const xlContinuous As Long = 1 Dim qdf As DAO.QueryDef Dim eerst As DAO.Recordset strQueryName = "tmpQueryToExportToExcel" If ObjectExists("Query", strQueryName) Then End If Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql) Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Dan MsgBox "Geen records om te exporteren.", vbInformation Volgende Set On Error ReDBTitle Ele 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.Blad 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).Selecteer intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range("A2").CopyFromRecordset eerst 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 = xl.NoneFilter. .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Colls.Auto ("A1").Selecteer .Visible = True End With 'xlWB.Close True 'Set xlWB = Nothing 'ApXL.Quit 'Set ApXL = Nothing End If End Function
Zo genoemd:
Private Sub AppendToExcelSQLStatemet_Example() Roep VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASHeet", "C:\Temp\Test.xlsx") End Sub
Waar u wordt gevraagd om in te voeren:
- SQL-query
- Naam uitvoerblad
- Pad en naam van uitvoerbestand.
Functie om te exporteren naar nieuw Excel-bestand
Met deze functies kunt u Access-objecten exporteren naar een nieuwe Excel-werkmap. Misschien vindt u ze nuttiger dan de eenvoudige enkele regels bovenaan het document.
Openbare functie ExportToExcel (strObjectType As String, strObjectName As String, Optioneel strSheetName As String, Optioneel strFileName As String) Dim eerst 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" Stel eerst = CurrentDb.OpenRecordset(strObjectNameD, d , dbSeeChanges) Case "Form" Set rst = Forms(strObjectName).RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges) Endcord Select If "rst records die moeten worden geëxporteerd.", vbInformation, GetDBTitle DoCmd.Hourglass False Anders Bij Fout Volgende Hervatten ApXL = GetObject(, "Excel.Application") If Err.Number 0 Stel vervolgens ApXL = CreateObject("Excel.Application") in End If Err. Wissen bij fout GoTo ExportToExcel_Err Set xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Set xlWSh = xlWBk.Worksheets("Blad1") If Len(strSheetName) > 0 Then xlWSh.Name = Left(strSheetName, 31) End If xlWSh .Range("A1").Selecteer Doen tot intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount).Name ApXL.ActiveCell.Offset(0, 1).Selecteer intCount = intCount + 1 lus eerste. MoveFirst xlWSh.Range("A2").CopyFromRecordset eerst met 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. 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) 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 ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Hervatten ExportToExcel_Exit Eindfunctie
De functie kan als volgt worden aangeroepen:
Private Sub ExportToExcel_Example() Roep VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASHeet") End Sub aan
