Hozzáférés a VBA -hoz - Excel importálása / exportálása - Lekérdezés, jelentés, táblázat és űrlapok

Ez az oktatóanyag bemutatja az adatok Excel -ből Access -táblázatba történő importálásának módjait, valamint az Access -objektumok (lekérdezések, jelentések, táblázatok vagy űrlapok) Excelbe történő exportálásának módjait.

Importálja az Excel fájlt a hozzáféréshez

Ha Excel fájlt szeretne importálni az Access szolgáltatásba, használja a acImport opciója DoCmd.TransferSheetsheet :

DoCmd.TransferSheetsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True

Vagy használhatod DoCmd.TransferText CSV fájl importálása:

DoCmd.TransferText acLinkDelim,, "Table1", "C: \ Temp \ Book1.xlsx", True

Az Excel importálása az Access funkcióba

Ezzel a funkcióval Excel vagy CSV fájlokat importálhat hozzáférési táblázatba:

Nyilvános függvény ImportFile (fájlnév karakterláncként, HasFieldNames logikai értékként, TableName mint karakterlánc) logikai értékű példaként: hívja az ImportFile fájlt ("Excel fájl kiválasztása", "Excel fájlok", "*.xlsx", "C: \", True , Igaz, "ExcelImportTest", Igaz, Igaz, hamis, Igaz) Hiba esetén GoTo err_handler Ha (Jobb (Fájlnév, 3) = "xls") Vagy ((Jobb (Fájlnév, 4) = "xlsx")) Akkor DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right (Filename, 3) = "csv") Akkor DoCmd.TransferText acLinkDelim,, TableName, Filename, True End If Exit_Thing: 'Clean up' Az Excel tábla már létezik… és törölje, ha igen. If ObjectExists ("Table", TableName) = True then DropTable (TableName) Set colWorksheets = Nothing Exit Function Szám = 3073) És errCount <3 Ezután errCount = errCount + 1 ElseIf Err.Number = 3127 Akkor MsgBox "Az összes lap mezői azonosak. Győződjön meg arról, hogy minden lap pontos oszlopneveket tartalmaz, ha importálni kívánja a többszörös ", vbCritical," MultiSheets not iden "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - ​​"& Err.Description ImportFile = False GoTo Exit_Thing Folytatás vége Ha vége Funkció

A funkciót így hívhatja:

Private Sub ImportFile_Example () VBA_Access_ImportExport.ImportFile hívása ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") Alrész

Hozzáférés a VBA exportálásához új Excel fájlba

Access -objektum új Excel -fájlba történő exportálásához használja a DoCmd.OutputTo módszer vagy a DoCmd.TransferSheetsheet módszer:

Lekérdezés exportálása Excelbe

Ez a VBA kódsor lekérdezést exportál az Excelbe a DoCmd használatával. OutputTo:

DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"

Vagy használhatja helyette a DoCmd.TransferSpreadsheet metódust:

DoCmd.TransferSheetsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True

Jegyzet: Ez a kód XLSX formátumba exportálódik. Ehelyett frissítheti az argumentumokat, hogy CSV vagy XLS fájlformátumba exportálja (pl. acFormatXLSX nak nek acFormatXLS).

Jelentés exportálása Excelbe

Ez a kódsor jelentést exportál az Excelbe a DoCmd használatával. OutputTo:

DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"

Vagy használhatja helyette a DoCmd.TransferSpreadsheet metódust:

DoCmd.TransferSheetsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True

Táblázat exportálása Excelbe

Ez a kódsor egy táblázatot exportál az Excelbe a DoCmd használatával. OutputTo:

DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"

Vagy használhatja helyette a DoCmd.TransferSpreadsheet metódust:

DoCmd.TransferSheetsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True

Űrlap exportálása Excelbe

Ez a kódsor űrlapot exportál az Excelbe a DoCmd használatával. OutputTo:

DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"

Vagy használhatja helyette a DoCmd.TransferSpreadsheet metódust:

DoCmd.TransferSheetsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True

Exportálás Excel funkciókba

Ezek az egysoros parancsok kiválóan alkalmasak új Excel fájlba történő exportálásra. Azonban nem tudnak exportálni egy meglévő munkafüzetbe. Az alábbi szakaszban olyan funkciókat mutatunk be, amelyek lehetővé teszik az exportálás hozzáfűzését egy meglévő Excel fájlhoz.

Az alábbiakban néhány további funkciót szerepeltettünk az új Excel fájlokba történő exportáláshoz, beleértve a hibakezelést és így tovább.

Exportálás meglévő Excel fájlba

A fenti kódpéldák nagyszerűen működnek az Access -objektumok új Excel -fájlba történő exportálásakor. Azonban nem tudnak exportálni egy meglévő munkafüzetbe.

Az Access objektumok exportálásához egy meglévő Excel munkafüzetbe a következő függvényt hoztuk létre:

Nyilvános függvény AppendToExcel (strObjectType Mint String, strObjectName As String, strSheetName As String, strFileName As String) Dim rst As DAO.Recordset Dim ApXL As Excel. Alkalmazás Dim xlWBk Excelként. Munkafüzet Dim xlWSh Excel ExcelWolksight 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) Case "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Vége Válassza ki, ha rst.RecordCount = 0 Aztán Msg beexport . ", vbInformation, GetDBTitle Else On Error Folytatás Következő Beállítás Állítsa be az xlWBk = ApXL.Workbooks.Open (strFil eName) Állítsa be az xlWSh = xlWBk.Sheets.Add xlWSh.Name = Bal oldalt (strSheetName, 31) xlWSh.Range ("A1"). Válassza a Do Before intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) lehetőséget. Név ApXL.ActiveCell.Offset (0, 1). Válassza ki az intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Válassza a .Range (.Selection, .Selection.End (xlToRight)). Válassza a xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Válassza ki a .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapTextSheet = FalseC. .EntireColumn.AutoFit xlWSh.Range ("A1"). Válassza a

A funkciót a következőképpen használhatja:

Private Sub AppendToExcel_Example () Call VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub

Figyelje meg, hogy meg kell határoznia:

  • Mit kell kimenni? Táblázat, jelentés, lekérdezés vagy űrlap
  • Objektum neve
  • Kimeneti lap neve
  • Kimeneti fájl elérési útja és neve.

Exportálja az SQL lekérdezést Excelbe

Ehelyett egy SQL -lekérdezést exportálhat Excelbe hasonló funkció használatával:

Nyilvános függvény AppendToExcelSQLStatemet (strsql String, strSheetName As String, strFileName As String) Dim strQueryName As String Dim ApXL Excelként. Alkalmazás Dim xlWBk Excelként. Munkakönyv Dim xlWSh Excelként. Munkalap Dim intCount As Integer 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 ("QueryNequerQuue Strue" Vége, ha Be van állítva qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Set rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Akkor az MsgBox "Nincs exportálandó rekord.", VbInformation, Get On Error ApXL = GetObject (, "Excel.Application") Ha Err.Number 0 akkor állítsa be ApXL = CreateObject ("Excel.Application") Vége, ha Err.Clear ApXL.Visible = False Set xlWBk = ApXL.Workbooks.Open (strFileName) Set xlWSh = xlWBk.Sheet s.Add xlWSh.Name = Bal (strSheetName, 31) xlWSh.Range ("A1"). Válassza a Do till intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset ( 0, 1). Válassza ki az intCount = intCount + 1 hurok első. ) .Select .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0,25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Bertern.Selection.Selection.Belector.Selection.Interior.Selection.Interior.PatternColorIndex = xlAutomatic. .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Válassza ki a .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColgeWolumn.Fut. ("A1"). Válassza a

Így hívják:

Private Sub AppendToExcelSQLStatemet_Example () Call VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx")

Hol kell megadni:

  • SQL lekérdezés
  • Kimeneti lap neve
  • Kimeneti fájl elérési útja és neve.

Funkció az új Excel fájlba történő exportáláshoz

Ezek a funkciók lehetővé teszik az Access objektumok exportálását egy új Excel munkafüzetbe. Hasznosabbnak találhatja őket, mint a dokumentum tetején található egyszerű sorok.

Nyilvános függvény ExportToExcel (strObjectType mint karakterlánc, strObjectName mint karakterlánc, opcionális strSheetName mint karakterlánc, opcionális strFileName mint karakterlánc) Dim rst as DAO.Recordset Dim ApXL objektumként Dim xlWBk mint objektum Dim xlWSh mint objektum Dim intClT mint Integer Const 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.OpenRecordsDaset, strObjectType , dbSeeChanges) Eset "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Vége Válassza ki, ha rst.RecordgC = 0 exportálandó rekordok. ", vbInformation, GetDBTitle DoCmd.Hourglass False Else On Error Folytatás Következő beállítás ApXL = GetObject (," Excel.Application ") Ha Err.Number 0 then Set Téved. Törlés On Error GoTo ExportToExcel_Err Set xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Set xlWSh = xlWBk.Worksheets ("Sheet1") Ha Len (strSheetName)> 0 Akkor xlWSh.Name = Bal (strSheet IfName, .Range ("A1"). Válassza a Do till intCount = rst.fields.Count ApXL.ActiveCell = elsődleges mezők (intCount) .Név ApXL.ActiveCell.Offset (0, 1). Válassza ki az intCount = intCount + 1 Loop első. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset elsőként az ApXL .Range ("A1"). Válassza a .Range (.Selection, .Selection.End (xlToRight)). Válassza ki a .Selection.Interior.Pattern = xlSolid .Selection lehetőséget. Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0,25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle = xlNone .Selection.AutoFilter .Cells.EntireColumn.EntireColumn.Auto B2 "). Válassza a .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 ") lehetőséget. Válassza a .Visible = True End Wi lehetőséget. újbóli próbálkozás: Ha a FileExists (strFileName) Akkor Öld meg a strFileName End If strFileName "" Majd xlWBk.SaveAs strFileName, FileFormat: = 56 End If rst.Close Set rst = Nothing DoCmd.Hourglass False End If ExportToExcel_Exit Exxit ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit End Function

A függvény így nevezhető:

Private Sub ExportToExcel_Example () VBA_Access_ImportExport.ExportToExcel hívása ("Table", "Table1", "VBASheet") End Sub
wave wave wave wave wave