Denne vejledning dækker måder at importere data fra Excel til en adgangstabel og måder at eksportere Access -objekter (forespørgsler, rapporter, tabeller eller formularer) til Excel på.
Importer Excel -fil til adgang
Hvis du vil importere en Excel -fil til Access, skal du bruge import mulighed for DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True
Eller du kan bruge DoCmd.TransferText for at importere en CSV -fil:
DoCmd.TransferText acLinkDelim, "Table1", "C: \ Temp \ Book1.xlsx", True
Importer Excel til Access -funktion
Denne funktion kan bruges til at importere en Excel -fil eller CSV -fil til en adgangstabel:
Offentlig funktion ImportFile (filnavn som streng, HasFieldNames som boolsk, tabelnavn som streng) Som boolsk 'Eksempelbrug: ring til ImportFile ("Vælg 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")) Så DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right (Filename, 3) = "csv") Så DoCmd.TransferText acLinkDelim, TableName, Filename, True End If Exit_Thing: 'Clean' Excel -tabellen eksisterer allerede … og slet den i så fald Hvis ObjectExists ("Table", TableName) = True Herefter indstiller DropTable (TableName) colWorksheets = Intet Afslut funktion err_handler: If (Err.Number = 3086 Eller Err.Number = 3274 Eller Err. Nummer = 3073) Og errCount <3 Derefter errCount = errCount + 1 ElseIf Err.Number = 3127 Så er MsgBox "Felterne i alle fanerne er de samme. Sørg for, at hvert ark har de nøjagtige kolonnenavne, hvis du ønsker at importere mulitple ", vbCritical," MultiSheets not identisk "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - "& Err.Description ImportFile = False GoTo Exit_Thing Genoptag End If End Function
Du kan kalde funktionen sådan:
Privat under ImportFile_Example () Ring til VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") End Sub
Få adgang til VBA -eksport til ny Excel -fil
Hvis du vil eksportere et Access -objekt til en ny Excel -fil, skal du bruge DoCmd.OutputTo metode eller DoCmd.TransferSpreadsheet -metode:
Eksportér forespørgsel til Excel
Denne linje med VBA -kode eksporterer en forespørgsel til Excel ved hjælp af DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"
Eller du kan i stedet bruge DoCmd.TransferSpreadsheet -metoden:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True
Bemærk: Denne kode eksporteres til XLSX -format. I stedet kan du opdatere argumenterne for at eksportere til et CSV- eller XLS -filformat i stedet (f.eks. acFormatXLSX til acFormatXLS).
Eksporter rapport til Excel
Denne kodelinje eksporterer en rapport til Excel ved hjælp af DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"
Eller du kan i stedet bruge DoCmd.TransferSpreadsheet -metoden:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True
Eksporter tabel til Excel
Denne kodelinje eksporterer en tabel til Excel ved hjælp af DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Tabel1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Eller du kan i stedet bruge DoCmd.TransferSpreadsheet -metoden:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True
Eksporter formular til Excel
Denne kodelinje eksporterer en formular til Excel ved hjælp af DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Eller du kan bruge DoCmd.TransferSpreadsheet -metoden i stedet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True
Eksporter til Excel -funktioner
Disse kommandoer med én linje fungerer fantastisk til at eksportere til en ny Excel -fil. De vil dog ikke være i stand til at eksportere til en eksisterende projektmappe. I afsnittet nedenfor introducerer vi funktioner, der giver dig mulighed for at tilføje din eksport til en eksisterende Excel -fil.
Nedenfor har vi inkluderet nogle ekstra funktioner til eksport til nye Excel -filer, herunder fejlhåndtering og mere.
Eksporter til eksisterende Excel -fil
Ovenstående kodeeksempler fungerer godt til at eksportere Access -objekter til en ny Excel -fil. De vil dog ikke være i stand til at eksportere til en eksisterende projektmappe.
For at eksportere Access -objekter til en eksisterende Excel -projektmappe har vi oprettet følgende 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 Integer As Long = -4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Vælg 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 Herefter MsgBoxed No records to . ", vbInformation, GetDBTitle Else På fejl Genoptag Næste sæt ApXL = GetObject (," Excel.Application ") Hvis Err.Number 0 Indstil derefter ApXL = CreateObject (" Excel.Application ") Slut hvis Err.Clear ApXL.Visible = False Indstil xlWBk = ApXL.Workbooks.Open (strFil eName) Indstil xlWSh = xlWBk.Sheets.Add xlWSh.Name = Venstre (strSheetName, 31) xlWSh.Range ("A1"). Vælg Gør indtil intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Navn ApXL.ActiveCell.Offset (0, 1) .Vælg intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset først med ApXL .Range ("A1"). Vælg .Range (.Valg,. .Selection.End (xlToRight)) .Vælg .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ælg .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False. .EntireColumn.AutoFit xlWSh.Range ("A1"). Vælg .Visible = True End med 'xlWB.Close True' Set xlWB = Intet 'ApXL.Quit' Set ApXL = Intet ende, hvis slutfunktion
Du kan bruge funktionen sådan:
Private Sub AppendToExcel_Example () Call VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Bemærk, at du bliver bedt om at definere:
- Hvad skal output? Tabel, rapport, forespørgsel eller formular
- Objektnavn
- Outputarkets navn
- Outputfilsti og navn.
Eksportér SQL -forespørgsel til Excel
I stedet kan du eksportere en SQL -forespørgsel til Excel ved hjælp af en lignende funktion:
Offentlig 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 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") Hvis Err.Number 0 Indstil derefter ApXL = CreateObject ("Excel.Application") Slut Hvis 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"). Vælg Do indtil intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset ( 0, 1) .Vælg intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst med ApXL .Range ("A1"). Vælg .Range (.Selection, .Selection.End (xlToRight) ) .Vælg .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"). Vælg .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit ("A1"). Vælg .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Kaldes sådan:
Private Sub AppendToExcelSQLStatemet_Example () Call VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Hvor du bliver bedt om at indtaste:
- SQL forespørgsel
- Outputarkets navn
- Outputfilsti og navn.
Funktion til eksport til ny Excel -fil
Disse funktioner giver dig mulighed for at eksportere Access -objekter til en ny Excel -projektmappe. Du finder dem måske mere nyttige end de enkle enkelte linjer øverst i dokumentet.
Public Function 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" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Afslut Vælg hvis rst.RecordCount = " poster, der 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 Fejl. Ryd ved fejl 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ælg Gør indtil intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset (0, 1) .Vælg intCount = intCount + 1 Loop rst. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset først med ApXL .Range ("A1"). Vælg .Range (.Selection, .Selection.End (xlToRight)). Vælg .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.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto.Auto. B2 "). Vælg .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = Falsk .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Vælg .Visible = True End Wi genforsøg: Hvis FileExists (strFileName) Så dræber strFileName End If If strFileName "" Så 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.Timeglas Falsk Genoptag ExportToExcel_Exit Afslut funktion
Funktionen kan kaldes sådan:
Privat under ExportToExcel_Example () Ring til VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet") End Sub
