Denne opplæringen vil dekke måtene for å importere data fra Excel til en tilgangstabell og måter å eksportere Access -objekter (forespørsler, rapporter, tabeller eller skjemaer) til Excel.
Importer Excel -fil til tilgang
Hvis du vil importere en Excel -fil til Access, bruker du acImport valg av DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True
Eller du kan bruke DoCmd.TransferText for å importere en CSV -fil:
DoCmd.TransferText acLinkDelim, "Table1", "C: \ Temp \ Book1.xlsx", True
Importer Excel til Access -funksjon
Denne funksjonen kan brukes til å importere en Excel -fil eller CSV -fil til en tilgangstabell:
Offentlig funksjon ImportFile (filnavn som streng, HasFieldNames som boolsk, tabellnavn som streng) Som boolsk 'Eksempelbruk: ring ImportFile ("Velg en Excel -fil", "Excel -filer", "*.xlsx", "C: \", True , True, "ExcelImportTest", True, True, false, True) On Error GoTo err_handler If (Right (Filnavn, 3) = "xls") Eller ((Right (Filnavn, 4) = "xlsx")) Da DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right (Filename, 3) = "csv") Da DoCmd.TransferText acLinkDelim, TableName, Filename, True End If Exit_Thing: 'Clean' Excel -tabellen eksisterer allerede … og slett den i så fall Hvis ObjectExists ("Table", TableName) = True Then DropTable (TableName) Sett colWorksheets = Nothing Exit Funksjon 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 "Feltene i alle fanene er like. Sørg for at hvert ark har de eksakte kolonnenavnene hvis du ønsker å importere 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 kalle funksjonen slik:
Private Sub ImportFile_Example () Ring VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") End Sub
Få tilgang til VBA -eksport til ny Excel -fil
Hvis du vil eksportere et Access -objekt til en ny Excel -fil, bruker du DoCmd.OutputTo metoden eller DoCmd.TransferSpreadsheet -metode:
Eksporter forespørsel til Excel
Denne linjen med VBA -kode vil eksportere en forespørsel til Excel ved hjelp av DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"
Eller du kan bruke DoCmd.TransferSpreadsheet -metoden i stedet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True
Merk: Denne koden eksporteres til XLSX -format. I stedet kan du oppdatere argumentene for å eksportere til et CSV- eller XLS -filformat i stedet (f.eks. acFormatXLSX til acFormatXLS).
Eksporter rapport til Excel
Denne kodelinjen eksporterer en rapport til Excel ved hjelp av DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"
Eller du kan bruke DoCmd.TransferSpreadsheet -metoden i stedet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True
Eksporter tabell til Excel
Denne kodelinjen eksporterer en tabell til Excel ved hjelp av DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Eller du kan bruke DoCmd.TransferSpreadsheet -metoden i stedet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True
Eksporter skjema til Excel
Denne kodelinjen eksporterer et skjema til Excel ved hjelp av DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Eller du kan bruke DoCmd.TransferSpreadsheet -metoden i stedet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True
Eksporter til Excel -funksjoner
Disse kommandoene med én linje fungerer utmerket for å eksportere til en ny Excel -fil. Imidlertid vil de ikke kunne eksportere til en eksisterende arbeidsbok. I delen nedenfor introduserer vi funksjoner som lar deg legge eksporten til en eksisterende Excel -fil.
Under det har vi inkludert noen ekstra funksjoner for å eksportere til nye Excel -filer, inkludert feilhåndtering og mer.
Eksporter til eksisterende Excel -fil
Kodeeksemplene ovenfor fungerer utmerket for å eksportere Access -objekter til en ny Excel -fil. Imidlertid vil de ikke kunne eksportere til en eksisterende arbeidsbok.
For å eksportere Access -objekter til en eksisterende Excel -arbeidsbok har vi opprettet følgende funksjon:
Offentlig funksjon 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 As Long = -4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Velg Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset (strObjectName, dbOpenDynaset, dbSeeChang) "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 Then MsgBoxed No records to . ", 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 Sett xlWBk = ApXL.Workbooks.Open (strFil eName) Angi xlWSh = xlWBk.Sheets.Add xlWSh.Name = Venstre (strSheetName, 31) xlWSh.Range ("A1"). Velg Gjør inntil intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Navn ApXL.ActiveCell.Offset (0, 1) .Velg intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset først med ApXL .Range ("A1"). Velg .Range (.Valg,. .Selection.End (xlToRight)). Velg .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0. xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Velg .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False. .EntireColumn.AutoFit xlWSh.Range ("A1"). Velg .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Du kan bruke funksjonen slik:
Private Sub AppendToExcel_Example () Call VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Legg merke til at du blir bedt om å definere:
- Hva skal jeg sende ut? Tabell, rapport, forespørsel eller skjema
- Objektnavn
- Navn på utskriftsark
- Utgangsfilbane og navn.
Eksporter SQL -spørring til Excel
I stedet kan du eksportere en SQL -spørring til Excel ved hjelp av en lignende funksjon:
Offentlig funksjon 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 ApXL = GetObject (, "Excel.Application") If Err.Number 0 Still deretter ApXL = CreateObject ("Excel.Application") End If Err.Clear ApXL.Visible = False Set xlWBk = ApXL.Workbooks.Open (strFileName) Set xlWSh = xlWBk.Sheet s.Add xlWSh.Name = Venstre (strSheetName, 31) xlWSh.Range ("A1"). Velg Gjør inntil intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset ( 0, 1) .Velg intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst Med ApXL .Range ("A1"). Velg .Range (.Selection, .Selection.End (xlToRight) ) .Velg .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0,25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Bil.LineStyle. .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Velg .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit. ("A1"). Velg .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Kalt slik:
Private Sub AppendToExcelSQLStatemet_Example () Call VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Hvor du blir bedt om å skrive:
- SQL -forespørsel
- Navn på utskriftsark
- Utgangsfilbane og navn.
Funksjon for eksport til ny Excel -fil
Disse funksjonene lar deg eksportere Access -objekter til en ny Excel -arbeidsbok. Du kan finne dem mer nyttige enn de enkle enkeltlinjene øverst i dokumentet.
Offentlig funksjon ExportToExcel (strObjectType As String, strObjectName As String, Valgfri strSheetName As String, Valgfri 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.Hourglass True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset ( , dbSeeChanges) Case "Form" Sett rst = Forms (strObjectName) .RecordsetClone Case "Report" Sett rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Velg Hvis rst.RecordCount = poster som skal eksporteres. ", 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 Err. Slett ved feil 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"). Velg Gjør inntil intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset (0, 1) .Velg intCount = intCount + 1 Loop rst. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset først med ApXL .Range ("A1"). Velg .Range (.Selection, .Selection.End (xlToRight)). Velg .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.Auto.Auto.Auto.Auto.AutoFilter.Auto.Auto.Auto.Auto.Auto.Auto.AutoFilter.AutoFilter.Auto.Auto.Auto.AutoFilter.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto. B2 "). Velg .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Velg .Visible = True End Wi prøve på nytt: Hvis FileExists (strFileName) Så dreper 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.Time Glass False Resume ExportToExcel_Exit End Function
Funksjonen kan kalles slik:
Private Sub ExportToExcel_Example () Call VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet") End Sub
