Този урок ще обхване начините за импортиране на данни от Excel в таблица за достъп и начини за експортиране на обекти на Access (заявки, отчети, таблици или формуляри) в Excel.
Импортирайте Excel файл в Access
За да импортирате Excel файл в Access, използвайте acImport опция на DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Таблица1", "C: \ Temp \ Book1.xlsx", Вярно
Или можете да използвате DoCmd.TransferText за да импортирате CSV файл:
DoCmd.TransferText acLinkDelim,, "Таблица1", "C: \ Temp \ Book1.xlsx", Вярно
Импортирайте Excel за функция за достъп
Тази функция може да се използва за импортиране на Excel файл или CSV файл в таблица за достъп:
Публична функция ImportFile (Име на файл като низ, HasFieldNames като Boolean, TableName As String) Като Boolean 'Примерна употреба: извикайте ImportFile ("Изберете файл на Excel", "Файлове на Excel", "*.xlsx", "C: \", Вярно , Вярно, "ExcelImportTest", Вярно, Вярно, невярно, Вярно) При грешка GoTo err_handler If (Right (Filename, 3) = "xls") Or ((Right (Filename, 4) = "xlsx")) Тогава DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right (Filename, 3) = "csv") Тогава DoCmd.TransferText acLinkDelim,, TableName, Filename, True End if Exit_Thing: ' Таблица на Excel вече съществува … и я изтрийте, ако е така. Number = 3073) И errCount <3 Тогава errCount = errCount + 1 ElseIf Err.Number = 3127 Тогава MsgBox "Полетата във всички раздели са еднакви. Моля, уверете се, че всеки лист има точни имена на колони, ако искате да импортирате множество ", vbCritical," Многолистове не са идентични "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - "& Err.Description ImportFile = False GoTo Exit_Thing Възобновяване End If End Функция
Можете да извикате функцията по следния начин:
Частен под ImportFile_Example () Обадете се VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") Краен под
Достъп до VBA експортиране в нов Excel файл
За да експортирате обект на Access в нов Excel файл, използвайте DoCmd.OutputTo метод или DoCmd.TransferSpreadsheet метод:
Експортирайте заявка в Excel
Този ред с код VBA ще експортира заявка в Excel, използвайки DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"
Или вместо това можете да използвате метода DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", Вярно
Забележка: Този код се експортира във формат XLSX. Вместо това можете да актуализирате аргументите, за да експортирате във CSV или XLS файлов формат (напр. acFormatXLSX да се acFormatXLS).
Експортиране на отчет в Excel
Този ред код ще експортира отчет в Excel, използвайки DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"
Или вместо това можете да използвате метода DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", Вярно
Експортирайте таблица в Excel
Този ред код ще експортира таблица в Excel, използвайки DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Таблица1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Или вместо това можете да използвате метода DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Таблица1", "c: \ temp \ ExportedTable.xls", Вярно
Експортиране на формуляр в Excel
Този ред код ще експортира формуляр в Excel, използвайки DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Или вместо това можете да използвате метода DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", Вярно
Експортиране в Excel функции
Тези команди от един ред работят чудесно за експортиране в нов файл на Excel. Те обаче няма да могат да експортират в съществуваща работна книга. В раздела по -долу представяме функции, които ви позволяват да добавите експортирането си към съществуващ Excel файл.
Под това сме включили някои допълнителни функции за експортиране в нови файлове на Excel, включително обработка на грешки и други.
Експортиране в съществуващ Excel файл
Горните примери за код работят чудесно за експортиране на обекти на Access в нов Excel файл. Те обаче няма да могат да експортират в съществуваща работна книга.
За да експортирате обекти на Access в съществуваща работна книга на Excel, създадохме следната функция:
Публична функция 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 xlWShT As Excel As Long = -4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Изберете случай strObjectType Дело "Таблица", "Заявка" Set rst = CurrentDb.OpenRecordset (strObjectName, dbOpenDynaCee, dbOpenDynaCe "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 " . ", vbInformation, GetDBTitle Друг при грешка Възобновяване Следваща Задайте ApXL = GetObject (," Excel.Application ") Ако Err.Number 0 Тогава задайте ApXL = CreateObject (" Excel.Application ") Край Ако Err.Clear ApXL.Visible = False Задайте xlWBk = ApXL.Workbooks.Open (strFil eName) Задайте xlWSh = xlWBk.Sheets.Add xlWSh.Name = Ляво (strSheetName, 31) xlWSh.Range ("A1"). Изберете Do Do intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Име ApXL.ActiveCell.Offset (0, 1) .Изберете intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst с ApXL .Range ("A1"). Изберете .Range (.Selection, .Selection.End (xlToRight)). Изберете .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior. xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Изберете .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells. .EntireColumn.AutoFit xlWSh.Range ("A1"). Изберете .Visible = True End с 'xlWB.Close True' Set xlWB = Нищо 'ApXL.Quit' Задайте ApXL = Нищо не прекратява
Можете да използвате функцията по следния начин:
Частен под AppendToExcel_Example () Обадете се VBA_Access_ImportExport.ExportToExcel ("Таблица", "Таблица1", "VBASheet", "C: \ Temp \ Test.xlsx") Краен под
Забележете, че сте помолени да определите:
- Какво да изведете? Таблица, отчет, заявка или формуляр
- Име на обект
- Име на изходния лист
- Път и име на изходния файл.
Експортирайте SQL заявка в Excel
Вместо това можете да експортирате SQL заявка в Excel, като използвате подобна функция:
Публична функция 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. xlBottom Докато = -4107 строителство xlVAlignCenter = -4108 строителство xlContinuous Докато = 1 Дим qdf Както DAO.QueryDef Дим RST Както DAO.Recordset strQueryName = "tmpQueryToExportToExcel" Ако ObjectExists ( "Заявка", strQueryName) След това CurrentDb.QueryDefs.Delete strQueryName End If Set qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Set rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Тогава MsgBox "Няма записи за експортиране." ApXL = GetObject (, "Excel.Application") Ако Err.Number 0 Тогава задайте ApXL = CreateObject ("Excel.Application") Край Ако 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"). Изберете Do Do intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Име ApXL.ActiveCell.Offset ( 0, 1) .Изберете intCount = intCount + 1 цикъл rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst с ApXL .Range ("A1"). Изберете .Range (.Selection, .Selection.End (xlToRight) ) .Изберете .Избор.Интериор.Шаблон = xlСолиден .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Изберете .ActiveWindow.FreezePanes = True .ActiveSheet.Cells. Изберете .ActiveSheet.Cells.WrapText = False. ("A1"). Изберете .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Нарича се така:
Private Sub AppendToExcelSQLStatemet_Example () Обадете се VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Където се изисква да въведете:
- SQL заявка
- Име на изходния лист
- Път и име на изходния файл.
Функция за експортиране в нов Excel файл
Тези функции ви позволяват да експортирате обекти на Access в нова работна книга на Excel. Може да ви се сторят по -полезни от обикновените единични редове в горната част на документа.
Публична функция ExportToExcel (strObjectType As String, strObjectName As String, Незадължително strSheetName As String, Незадължително strFileName As String) Dim rst As DAO.Recordset Dim ApXL As Dim Object xlWBk As Object Dim xlWSh As Object Dim 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 , dbSeeChanges) Case "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) записи, които трябва да бъдат експортирани. ", 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 Грешка Изчистване при грешка GoTo ExportToExcel_Err Set xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Set xlWSh = xlWBk.Worksheets ("Sheet1") If Len (strSheetName)> 0 Тогава xlWSh.NameShemeNeme .Range ("A1"). Изберете Do Do intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Име ApXL.ActiveCell.Offset (0, 1). Изберете intCount = intCount + 1 Loop rst. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Изберете .Range (.Selection, .Selection.End (xlToRight)). Select .Selection.Interior.Pattern = xlSolid .Selection. Интериор.ШаблонColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle = xlNone .Selection.AutoFilter. B2 "). Изберете .ActiveWindow.FreezePanes = True .ActiveSheet.Cells. Изберете .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Изберете. повторен опит: Ако FileExists (strFileName) След това Kill strFileName End Ако If strFileName "" Тогава xlWBk.SaveAs strFileName, FileFormat: = 56 End Ако rst.Close Задайте rst = Нищо ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err. Описание, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit Крайна функция
Функцията може да бъде извикана така:
Частен под ExportToExcel_Example () Обадете се VBA_Access_ImportExport.ExportToExcel ("Таблица", "Таблица1", "VBASheet") Краен под
