Denna handledning kommer att omfatta sätten att importera data från Excel till en åtkomsttabell och sätt att exportera Access -objekt (frågor, rapporter, tabeller eller formulär) till Excel.
Importera Excel -fil till åtkomst
Om du vill importera en Excel -fil till Access använder du acImport alternativet DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True
Eller så kan du använda DoCmd.TransferText för att importera en CSV -fil:
DoCmd.TransferText acLinkDelim, "Table1", "C: \ Temp \ Book1.xlsx", True
Importera Excel till åtkomstfunktion
Denna funktion kan användas för att importera en Excel -fil eller CSV -fil till en åtkomsttabell:
Offentlig funktion ImportFile (filnamn som sträng, HasFieldNames som booleskt, tabellnamn som sträng) Som booleskt exempel: använd CallFile ("Välj en Excel -fil", "Excel -filer", "*.xlsx", "C: \", True , True, "ExcelImportTest", True, True, false, True) On Error GoTo err_handler If (Right (Filnamn, 3) = "xls") Eller ((Right (Filnamn, 4) = "xlsx")) Då gör DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right (Filename, 3) = "csv") DoCmd.TransferText acLinkDelim, TableName, Filename, True End If Exit_Thing: 'Clean up' Excel -tabellen finns redan … och ta bort den i så fall Om ObjectExists ("Table", TableName) = True Då DropTable (TableName) Ange colWorksheets = Ingenting Avsluta funktion err_handler: If (Err.Number = 3086 Eller Err.Number = 3274 Eller Err. Number = 3073) And errCount <3 Then errCount = errCount + 1 ElseIf Err.Number = 3127 Then MsgBox "Fälten i alla flikarna är desamma. Se till att varje ark har de exakta kolumnnamnen om du vill importera mulitple ", vbCritical," MultiSheets not identisk "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - "& Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function
Du kan kalla funktionen så här:
Private Sub ImportFile_Example () Call VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") End Sub
Öppna VBA -export till ny Excel -fil
Om du vill exportera ett Access -objekt till en ny Excel -fil använder du DoCmd.OutputTo metod eller DoCmd.TransferSpreadsheet -metod:
Exportera fråga till Excel
Denna rad med VBA -kod exporterar en fråga till Excel med DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"
Eller så kan du använda metoden DoCmd.TransferSpreadsheet istället:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True
Notera: Denna kod exporteras till XLSX -format. Istället kan du uppdatera argumenten för att exportera till ett CSV- eller XLS -filformat istället (t.ex. acFormatXLSX till acFormatXLS).
Exportera rapport till Excel
Denna kodrad exporterar en rapport till Excel med DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"
Eller så kan du använda metoden DoCmd.TransferSpreadsheet istället:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True
Exportera tabell till Excel
Denna kodrad exporterar en tabell till Excel med DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Eller så kan du använda metoden DoCmd.TransferSpreadsheet istället:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True
Exportera formulär till Excel
Denna kodrad exporterar ett formulär till Excel med DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Eller så kan du använda metoden DoCmd.TransferSpreadsheet istället:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True
Exportera till Excel -funktioner
Dessa enradskommandon fungerar utmärkt att exportera till en ny Excel -fil. De kommer dock inte att kunna exportera till en befintlig arbetsbok. I avsnittet nedan introducerar vi funktioner som låter dig lägga till din export till en befintlig Excel -fil.
Under det har vi inkluderat några ytterligare funktioner för att exportera till nya Excel -filer, inklusive felhantering och mer.
Exportera till befintlig Excel -fil
Ovanstående kodexempel fungerar utmärkt för att exportera Access -objekt till en ny Excel -fil. De kommer dock inte att kunna exportera till en befintlig arbetsbok.
För att exportera Access -objekt till en befintlig Excel -arbetsbok har vi skapat följande funktion:
Public Function 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 Inteoston 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) "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 Sedan MsgBoxed No records to . ", vbInformation, GetDBTitle Annat Vid fel Återuppta Nästa uppsättning ApXL = GetObject (," Excel.Application ") Om Err.Number 0 Ställ sedan in ApXL = CreateObject (" Excel.Application ") Avsluta om Err.Clear ApXL.Visible = False Ställ in xlWBk = ApXL.Workbooks.Open (strFil eName) Ställ in xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Välj Gör tills intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Namn ApXL.ActiveCell.Offset (0, 1) .Välj intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset först med ApXL .Range ("A1"). Välj .Range (.Val,,. .Selection.End (xlToRight)). Välj .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Välj .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False. .EntireColumn.AutoFit xlWSh.Range ("A1"). Välj .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Du kan använda funktionen så här:
Private Sub AppendToExcel_Example () Call VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Lägg märke till att du blir ombedd att definiera:
- Vad ska matas ut? Tabell, rapport, fråga eller formulär
- Objektnamn
- Utmatningsarkets namn
- Utgående filsökväg och namn.
Exportera SQL -fråga till Excel
Istället kan du exportera en SQL -fråga till Excel med en liknande funktion:
Public Function 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 xl8 Center As = 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" strQDyName. End If Set qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Set rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Then MsgBox "No records to be exported.", VbInformation, GetDBTle Reset ApXL = GetObject (, "Excel.Application") If Err.Number 0 Ställ sedan in ApXL = CreateObject ("Excel.Application") Avsluta om Err.Clear ApXL.Visible = False Set xlWBk = ApXL.Workbooks.Open (strFileName) Set xlWSh = xlWBk.Sheet s.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Välj Gör tills intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset ( 0, 1) .Välj intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset först Med ApXL .Range ("A1"). Välj .Range (.Selection, .Selection.End (xlToRight) ) .Välj .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0,25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Brands.LineStyle. .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Välj .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFitXange. ("A1"). Välj .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Ringde så här:
Private Sub AppendToExcelSQLStatemet_Example () Call VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Där du ombeds att mata in:
- SQL -fråga
- Utmatningsarkets namn
- Utgående filsökväg och namn.
Funktion för att exportera till ny Excel -fil
Med dessa funktioner kan du exportera Access -objekt till en ny Excel -arbetsbok. Du kanske finner dem mer användbara än de enkla enkla raderna högst upp i dokumentet.
Public Function ExportToExcel (strObjectType As String, strObjectName As String, Valfri 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 On Error GoTo ExportToExcel_Err DoCmd.Timglas True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset ( , dbSeeChanges) Case "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Slut Välj Om rst.RecordCount = poster som ska exporteras. ", 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 Fela. Rensa vid fel 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"). Välj Gör tills intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset (0, 1) .Välj intCount = intCount + 1 Loop rst. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset först med ApXL .Range ("A1"). Välj .Range (.Selection, .Selection.End (xlToRight)). Välj .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.Auto.Auto. B2 "). Välj .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = Falskt .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Välj .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 ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Timglas Falsk Resume ExportToExcel_Exit End Function
Funktionen kan kallas så här:
Private Sub ExportToExcel_Example () Call VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet") End Sub
