У цьому посібнику буде розглянуто способи імпорту даних із Excel у таблицю доступу та способи експорту об’єктів Access (запитів, звітів, таблиць чи форм) до Excel.
Імпортуйте файл Excel у Access
Щоб імпортувати файл Excel до Access, скористайтеся acImport варіант DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True
Або можна використовувати DoCmd.TransferText щоб імпортувати файл CSV:
DoCmd.TransferText acLinkDelim,, "Таблиця1", "C: \ Temp \ Book1.xlsx", Істина
Імпортуйте Excel до функції доступу
Цю функцію можна використовувати для імпорту файлу Excel або файлу CSV у таблицю доступу:
Публічна функція ImportFile (Ім'я файлу як рядок, HasFieldNames як Boolean, TableName як рядок) Як Boolean 'Приклад використання: виклик ImportFile ("Виберіть файл Excel", "Файли Excel", "*.xlsx", "C: \", Істина , True, "ExcelImportTest", True, True, false, True) У разі помилки Перейти до err_handler If (Right (Ім'я файлу, 3) = "xls") Або ((Right (Ім'я файлу, 4) = "xlsx")) Тоді DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right (Ім'я файлу, 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
Викликати функцію можна так:
Приватний суб ImportFile_Example () Виклик VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") End Sub
Доступ до експорту 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", True
Примітка: Цей код експортується у формат 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", True
Експорт таблиці в Excel
Цей рядок коду експортує таблицю в Excel за допомогою DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Таблиця1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Або замість цього можна скористатися методом DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True
Експортувати форму в Excel
Цей рядок коду експортує форму до Excel за допомогою DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Або замість цього можна скористатися методом DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True
Експорт до функцій Excel
Ці команди з одного рядка чудово підходять для експорту в новий файл Excel. Однак вони не зможуть експортувати до наявної книги. У наведеному нижче розділі ми представляємо функції, які дозволяють додати ваш експорт до наявного файлу Excel.
Нижче ми додали деякі додаткові функції для експорту до нових файлів Excel, включаючи обробку помилок тощо.
Експорт до наявного файлу Excel
Наведені вище приклади коду чудово підходять для експорту об’єктів Access у новий файл Excel. Однак вони не зможуть експортувати до наявної книги.
Для експорту об’єктів Access у наявну книгу Excel ми створили таку функцію:
Загальнодоступна функція AppendToExcel (strObjectType As String, strObjectName As String, strSbjeetName As String, strFileName As String) Dim rst As DAO.Recordset Dim ApXL As Excel.Application Dim xlWBk As Excel.Workbook Dim xlWShT As Excel Довгий = -4161 Const xlCenter Як довгий = -4108 Const xlBottom Як довгий = -4107 Const xl Безперервний як довгий = 1 Виберіть регістр strObjectType Справа "Таблиця", "Запит" Встановити rst = CurrentDb.OpenRecordset (strObjectName, dbOpenDynaCee, dbOpenDynaCee, db "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName). . ", 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 цикл 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. Виберіть. .EntireColumn.AutoFit xlWSh.Range ("A1"). Виберіть .Visible = True End з "xlWB.Close True" Встановити xlWB = нічого "ApXL.Quit" Встановіть ApXL = Нічого не закінчиться, якщо функція End
Ви можете використовувати цю функцію так:
Приватний доповнення AppendToExcel_Example () Виклик VBA_Access_ImportExport.ExportToExcel ("Таблиця", "Таблиця1", "VBASheet", "C: \ Temp \ Test.xlsx")
Зверніть увагу, що вам пропонується визначити:
- Що вивести? Таблиця, звіт, запит або форма
- Назва об’єкта
- Назва вихідного аркуша
- Шлях і ім’я вихідного файлу.
Експорт запиту SQL до Excel
Замість цього ви можете експортувати запит SQL до Excel за допомогою подібної функції:
Загальнодоступна функція AppendToExcelSQLStatemet (strsql як рядок, strSheetName як рядок, strFileName як рядок) Dim strQueryName як рядок Dim ApXL як Excel.Додаток Dim xlWBk як Excel.Робоча книга Dim xlWSh як Excel.Worksheet Intem xlBottom As Long = -4107 Const xlVAlignCenter = -4108 Const xlContinuous As Long = 1 Dim ФРК Як DAO.QueryDef Dim RSt Як DAO.Recordset strQueryName = "tmpQueryToExportToExcel" Якщо ObjectExists ( "Query", strQueryName) Тоді CurrentDb.QueryDefs.Delete strQueryName Закінчити, якщо встановити qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Встановити rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) Якщо 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. Таблиця 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 з "xlWB. Закрийте True" Set xlWB = Nothing "ApXL.Quit" Set ApXL = Nothing End If End
Називається так:
Приватний додатковий додаток 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, Optional strSheetName As String, Optional 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 У разі помилки GoTo ExportToExcel_Err DoCmd.Hourglass True Select Case strObjectType Випадок "Таблиця", "Запит" Встановити rst = CurrentDb.OpenDesetDobect, OpenBest , dbSeeChanges) Випадок "Форма" Встановити rst = Форми (strObjectName) .RecordsetClone Справа "Звіт" Встановити rst = CurrentDb.OpenRecordset (Звіти (strObjectName). записи, які потрібно експортувати. ", vbInformation, GetDBTitle DoCmd.Hourglass False Else On Error Відновити наступне Встановити ApXL = GetObject (," Excel.Application ") Якщо Err.Number 0 Тоді встановити ApXL = CreateObject (" Excel.Application ") Закінчити, якщо Помилка. Очистити при помилці Перейти до ExportToExcel_Err Встановити xlWBk = ApXL.Workbooks.Add ApXL.Visible = Помилковий набір xlWSh = xlWBk.Worksheets ("Sheet1") If Len (strSheetName)> 0 Тоді xlWSh.NameSheme .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"). 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.Cull B2 "). Виберіть .ActiveWindow.FreezePanes = True .ActiveSheet.Cells. Виберіть .ActiveSheet.Cells.WrapText = False. Повторіть спробу: Якщо FileExists (strFileName) Тоді вбийте strFileName End If If strFileName "" Тоді xlWBk.SaveAs strFileName, FileFormat: = 56 End Якщо rst.Close Встановити rst = Ніщо DoCmd.Hourglass Неправильне завершення Якщо ExportToExcelCexcet False Exit: ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglase False Resume ExportToExcel_Exit End Функція
Функцію можна викликати так:
Приватний підрозділ ExportToExcel_Example () Виклик VBA_Access_ImportExport.ExportToExcel ("Таблиця", "Таблиця1", "VBASheet") Кінцевий підрозділ
