W tym samouczku omówiono sposoby importowania danych z programu Excel do tabeli programu Access oraz sposoby eksportowania obiektów programu Access (zapytań, raportów, tabel lub formularzy) do programu Excel.
Importuj plik Excel do programu Access
Aby zaimportować plik Excel do programu Access, użyj acImport opcja DoCmd.TransferArkusz kalkulacyjny :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:\Temp\Book1.xlsx", prawda
Lub możesz użyć DoCmd.TransferText aby zaimportować plik CSV:
DoCmd.TransferText acLinkDelim, , "Tabela1", "C:\Temp\Book1.xlsx", prawda
Importuj Excel do funkcji dostępu
Ta funkcja może być używana do importowania pliku Excel lub pliku CSV do Tabeli Dostępu:
Funkcja publiczna ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean ' Przykładowe zastosowanie: wywołanie ImportFile ("Wybierz plik Excel", "Pliki Excela", "*.xlsx", "C:\" , True ,True, "ExcelImportTest", True, True,false,True) W przypadku błędu GoTo err_handler If (Right(Filename, 3) = "xls") Lub ((Right(Filename, 4) = "xlsx")) Następnie DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If (Right(Filename, 3) = "csv") Then DoCmd.TransferText acLinkDelim, , TableName, Filename, True End If Exit_Thing: 'Wyczyść powiązanie w' Sprawdź, czy Tabela Excel już istnieje… i usuń ją, jeśli tak If ObjectExists("Table", TableName) = True Then DropTable (TableName) Set colWorksheets = Nic Funkcja wyjścia 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 "Pola we wszystkich zakładkach są takie same. Upewnij się, że każdy arkusz zawiera dokładne nazwy kolumn, jeśli chcesz zaimportować wiele", vbCritical, "MultiSheets nie są identyczne" ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number & " - " & Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function
Możesz wywołać funkcję w ten sposób:
Private Sub ImportFile_Example() Wywołanie VBA_Access_ImportExport.ImportFile("C:\Temp\Book1.xlsx", True, "Imported_Table_1") End Sub
Uzyskaj dostęp do eksportu VBA do nowego pliku Excel
Aby wyeksportować obiekt programu Access do nowego pliku Excel, użyj DoCmd.OutputTo metoda lub Metoda DoCmd.TransferSpreadsheet:
Eksportuj zapytanie do Excela
Ten wiersz kodu VBA wyeksportuje zapytanie do programu Excel przy użyciu DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:\temp\ExportedQuery.xls"
Możesz też użyć metody DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:\temp\ExportedQuery.xls", prawda
Notatka: Ten kod jest eksportowany do formatu XLSX. Zamiast tego możesz zaktualizować argumenty, aby zamiast tego eksportować do formatu pliku CSV lub XLS (np. AcFormatXLSX do ACFormatXLS).
Eksportuj raport do Excela
Ten wiersz kodu wyeksportuje raport do programu Excel za pomocą DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, „Report1”, acFormatXLSX, „c:\temp\ExportedReport.xls”
Możesz też użyć metody DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:\temp\ExportedReport.xls", prawda
Eksportuj tabelę do Excela
Ten wiersz kodu wyeksportuje tabelę do programu Excel za pomocą DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:\temp\ExportedTable.xls"
Możesz też użyć metody DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:\temp\ExportedTable.xls", prawda
Eksportuj formularz do Excela
Ten wiersz kodu wyeksportuje formularz do Excela za pomocą DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:\temp\ExportedForm.xls"
Możesz też użyć metody DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:\temp\ExportedForm.xls", prawda
Funkcje eksportu do Excela
Te jednowierszowe polecenia świetnie sprawdzają się podczas eksportowania do nowego pliku Excel. Jednak nie będą mogli eksportować do istniejącego skoroszytu. W poniższej sekcji przedstawiamy funkcje, które umożliwiają dołączenie eksportu do istniejącego pliku Excel.
Poniżej zamieściliśmy kilka dodatkowych funkcji do eksportu do nowych plików Excela, w tym obsługę błędów i nie tylko.
Eksportuj do istniejącego pliku Excel
Powyższe przykłady kodu świetnie sprawdzają się w przypadku eksportowania obiektów programu Access do nowego pliku programu Excel. Jednak nie będą mogli eksportować do istniejącego skoroszytu.
Aby wyeksportować obiekty programu Access do istniejącego skoroszytu programu Excel, utworzyliśmy następującą funkcję:
Funkcja publiczna 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 Wybierz przypadek 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 "Brak rekordów do eksportu .", vbInformation, GetDBTitle Else On Error Resume Next Set ApXL = GetObject(, "Excel.Application") If Err.Number 0 Następnie ustaw ApXL = CreateObject("Excel.Application") End If Err.Clear ApXL.Visible = False Ustaw xlWBk = ApXL.Workbooks.Open(strFil eName) Set xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left(strSheetName, 31) xlWSh.Range("A1").Wybierz Do dopóki intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount). Nazwa ApXL.ActiveCell.Offset(0, 1).Select intCount = intCount + 1 pętla 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. xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.Crapell.Fals = .EntireColumn.AutoFit xlWSh.Range("A1").Select .Visible = True End With 'xlWB.Close True 'Set xlWB = Nothing 'ApXL.Quit 'Set ApXL = Nic End If End Function
Możesz użyć funkcji w ten sposób:
Private Sub AppendToExcel_Example() Wywołanie VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet", "C:\Temp\Test.xlsx") End Sub
Zauważ, że zostaniesz poproszony o zdefiniowanie:
- Co do wyjścia? Tabela, raport, zapytanie lub formularz
- Nazwa obiektu
- Nazwa arkusza wyjściowego
- Ścieżka i nazwa pliku wyjściowego.
Eksportuj zapytanie SQL do Excela
Zamiast tego możesz wyeksportować zapytanie SQL do programu Excel, korzystając z podobnej funkcji:
Funkcja publiczna 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.QueryDefs. End If Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql) Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Then MsgBox "Brak rekordów do wyeksportowania.", 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 Set xlWBk = ApXL.Workbooks.Open(strFileName) Set xlWSh = xlWBk.Arkusz s.Add xlWSh.Name = Left(strSheetName, 31) xlWSh.Range("A1").Wybierz Do dopóki intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount).Name ApXL.ActiveCell.Offset( 0, 1).Select intCount = intCount + 1 pętla 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.CellF .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = Fałsz .ActiveSheet.Cells.S.RangeColumn ("A1").Select .Visible = True End With 'xlWB.Close True 'Set xlWB = Nic 'ApXL.Quit 'Set ApXL = Nic End If End Function
Nazywany tak:
Private Sub AppendToExcelSQLStatemet_Example() Wywołaj VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASheet", "C:\Temp\Test.xlsx") End Sub
Gdzie jesteś proszony o wprowadzenie:
- Zapytanie SQL
- Nazwa arkusza wyjściowego
- Ścieżka i nazwa pliku wyjściowego.
Funkcja eksportu do nowego pliku Excel
Te funkcje umożliwiają eksportowanie obiektów programu Access do nowego skoroszytu programu Excel. Mogą okazać się bardziej przydatne niż proste pojedyncze wiersze na górze dokumentu.
Funkcja publiczna ExportToExcel(strObjectType As String, strObjectName As String, Opcjonalnie strSheetName As String, Opcjonalnie 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 W przypadku błędu GoTo ExportToExcel_Err DoCmd.Hourglass True Wybierz przypadek strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDyset , 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 "Nie rekordy do wyeksportowania.", 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 Błądzić. Wyczyść przy błędzie 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").Wybierz Do dopóki intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount).Name ApXL.ActiveCell.Offset(0, 1)).Wybierz intCount = intCount + 1 pętla 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.Fitire" B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = Fałsz .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range("A1").Select .Visible = True End Wi Ponowna próba: 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 Wyjście ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit Koniec funkcji
Funkcję można nazwać tak:
Private Sub ExportToExcel_Example() Wywołanie VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet") End Sub
