Tento tutoriál se bude zabývat způsoby importu dat z aplikace Excel do tabulky aplikace Access a způsoby exportu objektů aplikace Access (dotazů, sestav, tabulek nebo formulářů) do aplikace Excel.
Importujte soubor aplikace Excel do aplikace Access
Chcete -li importovat soubor aplikace Excel do aplikace Access, použijte importovat možnost List DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True
Nebo můžete použít DoCmd.TransferText importovat soubor CSV:
DoCmd.TransferText acLinkDelim,, "Tabulka1", "C: \ Temp \ Book1.xlsx", True
Importovat aplikaci Excel do funkce Access
Tuto funkci lze použít k importu souboru aplikace Excel nebo souboru CSV do přístupové tabulky:
Veřejná funkce ImportFile (Název souboru jako řetězec, HasFieldNames jako Boolean, Název tabulky jako řetězec) Jako Boolean 'Příklad použití: volání ImportFile („Vyberte soubor aplikace Excel“, „Soubory aplikace Excel“, „*.xlsx“, „C: \“, True "Pravda," ExcelImportTest ", True, True, false, True) Při chybě GoTo err_handler If (Right (Filename, 3) =" xls ") Nebo ((Right (Filename, 4) =" xlsx ")) Then DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right (Filename, 3) = "csv") Then DoCmd.TransferText acLinkDelim,, TableName, Filename, True End If Exit_Thing: in Clean Up Tabulka aplikace Excel již existuje … a pokud je to možné, odstraňte ji. Pokud ObjectExists ("Table", TableName) = True Then DropTable (TableName) Set colWorksheets = Nothing Exit Function 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 "Pole na všech kartách jsou stejná. Ujistěte se prosím, že každý list má přesné názvy sloupců, pokud chcete importovat více ", vbCritical," více listů není identických "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - "& Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function
Funkci můžete volat takto:
Private Sub ImportFile_Example () Volání VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") End Sub
Přístup k exportu VBA do nového souboru aplikace Excel
Chcete -li exportovat objekt aplikace Access do nového souboru aplikace Excel, použijte DoCmd.OutputTo metoda nebo Metoda DoCmd.TransferSpreadsheet:
Export dotazu do aplikace Excel
Tento řádek kódu VBA exportuje dotaz do aplikace Excel pomocí DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"
Nebo místo toho můžete použít metodu DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True
Poznámka: Tento kód se exportuje do formátu XLSX. Místo toho můžete aktualizovat argumenty pro export do formátu CSV nebo XLS (např. acFormatXLSX na acFormatXLS).
Export zprávy do aplikace Excel
Tento řádek kódu exportuje sestavu do aplikace Excel pomocí DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"
Nebo místo toho můžete použít metodu DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True
Exportovat tabulku do Excelu
Tento řádek kódu exportuje tabulku do aplikace Excel pomocí DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Nebo místo toho můžete použít metodu DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True
Exportovat formulář do Excelu
Tento řádek kódu exportuje formulář do aplikace Excel pomocí DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Nebo místo toho můžete použít metodu DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True
Export do funkcí Excelu
Tyto příkazy na jednom řádku fungují skvěle při exportu do nového souboru aplikace Excel. Nebudou však moci exportovat do stávajícího sešitu. V níže uvedené části představujeme funkce, které vám umožňují připojit export do existujícího souboru aplikace Excel.
Níže jsme zahrnuli některé další funkce pro export do nových souborů aplikace Excel, včetně zpracování chyb a dalších.
Exportovat do existujícího souboru aplikace Excel
Výše uvedené příklady kódu fungují skvěle při exportu objektů aplikace Access do nového souboru aplikace Excel. Nebudou však moci exportovat do stávajícího sešitu.
Chcete -li exportovat objekty aplikace Access do existujícího sešitu aplikace Excel, vytvořili jsme následující funkci:
Veřejná funkce AppendToExcel (strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String) Dim první jako DAO.Recordset Dim ApXL jako Excel.Application Dim xlWBk As Excel.Workbook Dim xlWSh As Excel.Worksheet Dim intCount Jak dlouhý = -4161 Const xlCenter Jak dlouhý = -4108 Const xlBottom Jak dlouhý = -4107 Const xlContinuous Jako dlouhý = 1 Vyberte případ strObjectType Case "Tabulka", "Query" Set rst = CurrentDb.OpenRecordset (strObjectName, dbOpenDynaset, dbSeeChanges) "Formulář" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 Then MsgBox "Žádné záznamy k exportu . ", vbInformation, GetDBTitle Jinak při chybě Pokračovat Další Nastavit ApXL = GetObject (," Excel.Application ") Pokud Err.Number 0, pak nastavit ApXL = CreateObject (" Excel.Application ") Konec Pokud Err.Clear ApXL.Visible = False Nastavit xlWBk = ApXL.Workbooks.Open (strFil eName) Set xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Vyberte Do Do intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Název ApXL. .Selection.End (xlToRight)). Vyberte .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"). Vyberte .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText.Celkový. .EntireColumn.AutoFit xlWSh.Range ("A1"). Vyberte .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Funkci můžete použít takto:
Private Sub AppendToExcel_Example () Volání VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Všimněte si, že jste požádáni o definování:
- Co na výstup? Tabulka, sestava, dotaz nebo formulář
- Název objektu
- Název výstupního listu
- Cesta a název výstupního souboru.
Exportujte dotaz SQL do aplikace Excel
Místo toho můžete exportovat dotaz SQL do aplikace Excel pomocí podobné funkce:
Veřejná funkce 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 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") 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, GetDB 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.Sheet s.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Vyberte Do Do intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset ( 0, 1). Vyberte intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset nejprve pomocí ApXL .Range ("A1"). Vyberte .Range (.Selection, .Selection.End (xlToRight) ) .Vyberte .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0,25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.NineStyle .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Vyberte .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit x ("A1"). Vyberte .Visible = True End s 'xlWB.Close True' Set xlWB = Nic 'ApXL.Quit' Set ApXL = Nic Konec If Konec Funkce
Nazývá se takto:
Private Sub AppendToExcelSQLStatemet_Example () Volání VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Kde budete vyzváni k zadání:
- SQL dotaz
- Název výstupního listu
- Cesta a název výstupního souboru.
Funkce pro export do nového souboru aplikace Excel
Tyto funkce vám umožňují exportovat objekty aplikace Access do nového sešitu aplikace Excel. Možná vám přijdou užitečnější než jednoduché jednotlivé řádky v horní části dokumentu.
Veřejná funkce ExportToExcel (strObjectType jako řetězec, strObjectName jako řetězec, volitelný strSheetName jako řetězec, volitelný strFileName jako řetězec) Dim první jako DAO.Recordset Dim ApXL jako Object Dim xlWBk jako Object Dim xlWSh As Object Dim intCount As Integer Const xlToR 4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinous As Long = 1 On Error GoTo ExportToExcel_Err DoCmd.Hourglass True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRjectNetb (strO , dbSeeChanges) Případ "Formulář" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 Then Ms záznamy k exportu. ", 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 Chybovat. Vymazat při chybě 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) .Range ("A1"). Vyberte Do Do intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset (0, 1). Select intCount = intCount + 1 Loop rst. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset první s ApXL .Range ("A1"). Vyberte .Range (.Selection, .Selection.End (xlToRight)). Vyberte .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. B2. 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: DoCm ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit End Function
Funkci lze nazvat takto:
Private Sub ExportToExcel_Example () Volání VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet") End Sub
