Всем привет! Материал сегодня будет посвящен рассмотрению возможности Access выгружать Recordset в Excel на VBA. Данный способ достаточно простой и предполагает использование Recordset как формы, так и специально созданного объекта.
Ранее мы с Вами уже рассматривали возможность выгрузки данных из Access в Excel в материале «Выгрузка данных из Access в шаблон Word и Excel», но там мы использовали специально созданный шаблон, что не совсем удобно, если например, нам необходимо выгрузить просто набор данных с заголовками полей.
Также если кого интересует, недавно мы рассматривали возможность выгрузки данных из базы MS SQL Server в формат CSV (текстовый файл с разделителями) с помощью VBA Access в материале «Экспорт данных в CSV файл из Microsoft SQL Server, используя Access 2003».
Сейчас я покажу простой пример реализации возможности выгружать наборы данных с заголовками из базы MS SQL Server средствами VBA Access в Excel.
Весь смысл сводится в использование метода CopyFromRecordset, который позволяет переносить Recordset в Excel в том виде, какой он и есть, т.е. в виде таблицы. Единственное что нам необходимо будет сделать, это выгрузить заголовки, чтобы было понятней, что за данные содержатся в той или иной колонке.
Итак, давайте приступать и для начала рассмотрим исходные данные.
Примечание! В качестве примера источником данных у меня будет выступать MS SQL Server 2012 Express, а в качестве клиента ADP проект Access 2003. Также на компьютере клиенте установлен Microsoft Office 2010.
Содержание
- Исходные данные
- Код VBA для выгрузки Recordset формы в Excel
- Код VBA для выгрузки объекта Recordset в Excel
Исходные данные
Допустим, на сервере у нас есть таблица TestTable.
Код SQL
CREATE TABLE TestTable(
ID INT IDENTITY(1,1) NOT NULL,
ProductName VARCHAR(50) NOT NULL,
Price MONEY NULL,
CONSTRAINT PK_TestTable PRIMARY KEY CLUSTERED (ID ASC)
)
GO
И она содержит следующие данные.
Код SQL
SELECT * FROM TestTable
Также допустим, что в ADP проекте Access у нас есть форма, источником данных которой выступает наша тестовая таблица TestTable.
Сначала давайте рассмотрим пример выгрузки объекта Recordset формы в Excel. Для этого добавляем на форму кнопку, для примера я ее назвал RSExportInExcel. В обработку события нажатие кнопки вставляем следующий код, я его прокомментировал:
Код VBA
Option Compare Database
Private Sub RSExportInExcel_Click()
On Error GoTo Err1
'Переменные
Dim XLApp As Object, XLBook As Object, XLSheet As Object, RS As ADODB.Recordset
Dim CountColumn As Integer, WidthColumn As Integer
'Создаем объекты: Excel, Книгу, Лист
Set XLApp = CreateObject("Excel.Application")
Set XLBook = XLApp.Workbooks.add
Set XLSheet = XLBook.Worksheets(1)
'Получаем Recordset формы
Set RS = Me.Recordset
'Узнаем количество колонок в Recordset
CountColumn = RS.Fields.count
'Циклом заполняем заголовки колонок
For i = 0 To CountColumn - 1
'Передвигаемся по колонкам в Excel путем смещения
XLSheet.Range("A1").offset(0, i).value = RS.Fields(i).NAME
'Немного подкорректируем внешний вид выгрузки
'Ширину колонки определим динамически на основе длины поля, но не более 20 и не менее 6
WidthColumn = Len(RS.Fields(i).NAME) + 2
If WidthColumn > 20 Then
WidthColumn = 20
ElseIf WidthColumn < 6 Then
WidthColumn = 10
End If
'Задаем для заголовка
'Перенос по словам
XLSheet.Rows(1).WrapText = True
'Выравнивание
XLSheet.Rows(1).HorizontalAlignment = xlCenter
XLSheet.Rows(1).VerticalAlignment = xlCenter
'Цвет фона
XLSheet.Rows(1).Interior.ColorIndex = 15
'Ширина
XLSheet.Columns(i + 1).ColumnWidth = WidthColumn
Next
'Записываем Recordset в Excel
XLSheet.Range("A2").CopyFromRecordset RS
'Делаем видимым Excel
XLApp.Visible = True
Ex1:
Exit Sub
Err1:
MsgBox Err.Description
Resume Ex1
End Sub
Сохраняем изменения и пробуем нажать на кнопку. В итоге у нас запустится Excel, а в нем будут необходимые нам данные.
Примечание! Свойства HorizontalAlignment и VerticalAlignment могут не работать, если на компьютере не установлен Microsoft Office 2010, поэтому в случае возникновения ошибок связанных с этими свойствами просто закомментируйте их.
Код VBA для выгрузки объекта Recordset в Excel
Теперь давайте напишем код, который позволяет выгружать объект Recordset, данные которого получены, скажем с помощью запроса к базе данных. Для этого добавьте еще одну кнопку (я ее назвал RSExportInExcel2) и вставьте немного модифицированный код:
Код VBA
Private Sub RSExportInExcel2_Click()
On Error GoTo Err1
'Переменные
Dim XLApp As Object, XLBook As Object, XLSheet As Object, RS As ADODB.Recordset
Dim CountColumn As Integer, WidthColumn As Integer, StrSQLInExcel As String
'Создаем объекты: Excel, Книгу, Лист
Set XLApp = CreateObject("Excel.Application")
Set XLBook = XLApp.Workbooks.add
Set XLSheet = XLBook.Worksheets(1)
'Создаем новый Recordset
Set RS = New ADODB.Recordset
'Текст запроса SQL, т.е. сюда можете вставить свой запрос, например, формировать его динамически
StrSQLInExcel = "SELECT * FROM TestTable"
'Получаем данные по текущему соединению
RS.open StrSQLInExcel, CurrentProject.Connection
'Узнаем количество колонок в Recordset
CountColumn = RS.Fields.count
'Циклом заполняем заголовки колонок
For i = 0 To CountColumn - 1
'Передвигаемся по колонкам в Excel путем смещения
XLSheet.Range("A1").offset(0, i).value = RS.Fields(i).NAME
'Немного подкорректируем внешний вид выгрузки
'Ширину колонки определим динамически на основе длины поля, но не более 20 и не менее 6
WidthColumn = Len(RS.Fields(i).NAME) + 2
If WidthColumn > 20 Then
WidthColumn = 20
ElseIf WidthColumn < 6 Then
WidthColumn = 10
End If
'Задаем для заголовка
'Перенос по словам
XLSheet.Rows(1).WrapText = True
'Выравнивание
XLSheet.Rows(1).HorizontalAlignment = xlCenter
XLSheet.Rows(1).VerticalAlignment = xlCenter
'Цвет фона
XLSheet.Rows(1).Interior.ColorIndex = 15
'Ширина
XLSheet.Columns(i + 1).ColumnWidth = WidthColumn
Next
'Записываем Recordset в Excel
XLSheet.Range("A2").CopyFromRecordset RS
'Делаем видимым Excel
XLApp.Visible = True
'Закрываем Recordset
RS.close
Set RS = Nothing
Ex1:
Exit Sub
Err1:
MsgBox Err.Description
Resume Ex1
End Sub
Снова сохраняем и пробуем нажать на кнопку, в итоге у нас получится точно такая же выгрузка, как и чуть ранее, только сейчас в качестве источника данных Recordset у нас может выступать любой запрос, а не только данные формы.
На этом у меня все! Надеюсь, материал был Вам полезен, пока!
Just getting to grips some VBA (this stuff’s new to me so bear with us!)
From query ContactDetails_SurveySoftOutcomes, I’m trying to first find a list of all the unique values in the DeptName field in that query, hence the rsGroup Dim storing a Grouped query on the DeptName field.
I’m then going to use this grouped list as way of cycling through the same query again, but passing through each unique entry as a filter on the whole recordset and export each filtered recordset to its own Excel spreadsheet… see the Do While Not loop.
My code’s tripping up on the DoCmd.TransferSpreadsheet … rsExport part. I’m a bit new to this, but I guess my Dim name rsExport for the recordset isn’t accepted in this method..?
Is there an easy fix to the code I’ve already started or should I be using a completely different approach to achieve all this?
Code:
Public Sub ExportSoftOutcomes()
Dim rsGroup As DAO.Recordset
Dim Dept As String
Dim myPath As String
myPath = "C:MyFolder"
Set rsGroup = CurrentDb.OpenRecordset("SELECT ContactDetails_SurveySoftOutcomes.DeptName " _
& "FROM ContactDetails_SurveySoftOutcomes GROUP BY ContactDetails_SurveySoftOutcomes.DeptName", dbOpenDynaset)
Do While Not rsGroup.EOF
Dept = rsGroup!DeptName
Dim rsExport As DAO.Recordset
Set rsExport = CurrentDb.OpenRecordset("SELECT * FROM ContactDetails_SurveySoftOutcomes " _
& "WHERE (((ContactDetails_SurveySoftOutcomes.DeptName)='" & Dept & "'))", dbOpenDynaset)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, rsExport, myPath & Dept & "" & Dept & " - Soft Outcomes Survey.xls", True
rsGroup.MoveNext
Loop
End Sub
Fixed Code:
Public Sub ExportSoftOutcomes()
Dim rsGroup As DAO.Recordset
Dim Dept As String
Dim myPath As String
myPath = "C:MyFolder"
Set rsGroup = CurrentDb.OpenRecordset("SELECT ContactDetails_SurveySoftOutcomes.DeptName " _
& "FROM ContactDetails_SurveySoftOutcomes GROUP BY ContactDetails_SurveySoftOutcomes.DeptName", dbOpenDynaset)
Do While Not rsGroup.EOF
Dept = rsGroup!DeptName
Dim rsExportSQL As String
rsExportSQL = "SELECT * FROM ContactDetails_SurveySoftOutcomes " _
& "WHERE (((ContactDetails_SurveySoftOutcomes.DeptName)='" & Dept & "'))"
Dim rsExport As DAO.QueryDef
Set rsExport = CurrentDb.CreateQueryDef("myExportQueryDef", rsExportSQL)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "myExportQueryDef", myPath & Dept & "" & Dept & " - Soft Outcomes Survey.xls", True
CurrentDb.QueryDefs.Delete rsExport.Name
rsGroup.MoveNext
Loop
End Sub
Содержание
- Как в Access на VBA выгрузить Recordset в Excel?
- Исходные данные
- Код VBA для выгрузки Recordset формы в Excel
- Код VBA для выгрузки объекта Recordset в Excel
- Метод DoCmd.TransferSpreadsheet (Access)
- Синтаксис
- Параметры
- Примечания
- Пример
- Поддержка и обратная связь
- Subscribe to Developer Soapbox
- Export Microsoft Access Data to Excel
- Developer
- Developer
- The Simple Way
- For More Complex Cases
- DEVelopers HUT
- Taking Things Even Further :: ExportRecordset2XLS V2.0!
- Download
- Disclaimer/Notes:
- The YouTube Demo File:
- The Original Article File:
- 21 responses on “ MS Access – VBA – Export RecordSet to Excel ”
- Leave a Reply Cancel reply
- My YouTube Channel
Как в Access на VBA выгрузить Recordset в Excel?
Всем привет! Материал сегодня будет посвящен рассмотрению возможности Access выгружать Recordset в Excel на VBA. Данный способ достаточно простой и предполагает использование Recordset как формы, так и специально созданного объекта.
Ранее мы с Вами уже рассматривали возможность выгрузки данных из Access в Excel в материале «Выгрузка данных из Access в шаблон Word и Excel», но там мы использовали специально созданный шаблон, что не совсем удобно, если например, нам необходимо выгрузить просто набор данных с заголовками полей.
Также если кого интересует, недавно мы рассматривали возможность выгрузки данных из базы MS SQL Server в формат CSV (текстовый файл с разделителями) с помощью VBA Access в материале «Экспорт данных в CSV файл из Microsoft SQL Server, используя Access 2003».
Сейчас я покажу простой пример реализации возможности выгружать наборы данных с заголовками из базы MS SQL Server средствами VBA Access в Excel.
Весь смысл сводится в использование метода CopyFromRecordset, который позволяет переносить Recordset в Excel в том виде, какой он и есть, т.е. в виде таблицы. Единственное что нам необходимо будет сделать, это выгрузить заголовки, чтобы было понятней, что за данные содержатся в той или иной колонке.
Итак, давайте приступать и для начала рассмотрим исходные данные.
Примечание! В качестве примера источником данных у меня будет выступать MS SQL Server 2012 Express, а в качестве клиента ADP проект Access 2003. Также на компьютере клиенте установлен Microsoft Office 2010.
Исходные данные
Допустим, на сервере у нас есть таблица TestTable.
И она содержит следующие данные.
Также допустим, что в ADP проекте Access у нас есть форма, источником данных которой выступает наша тестовая таблица TestTable.
Код VBA для выгрузки Recordset формы в Excel
Сначала давайте рассмотрим пример выгрузки объекта Recordset формы в Excel. Для этого добавляем на форму кнопку, для примера я ее назвал RSExportInExcel. В обработку события нажатие кнопки вставляем следующий код, я его прокомментировал:
Сохраняем изменения и пробуем нажать на кнопку. В итоге у нас запустится Excel, а в нем будут необходимые нам данные.
Примечание! Свойства HorizontalAlignment и VerticalAlignment могут не работать, если на компьютере не установлен Microsoft Office 2010, поэтому в случае возникновения ошибок связанных с этими свойствами просто закомментируйте их.
Код VBA для выгрузки объекта Recordset в Excel
Теперь давайте напишем код, который позволяет выгружать объект Recordset, данные которого получены, скажем с помощью запроса к базе данных. Для этого добавьте еще одну кнопку (я ее назвал RSExportInExcel2) и вставьте немного модифицированный код:
Снова сохраняем и пробуем нажать на кнопку, в итоге у нас получится точно такая же выгрузка, как и чуть ранее, только сейчас в качестве источника данных Recordset у нас может выступать любой запрос, а не только данные формы.
На этом у меня все! Надеюсь, материал был Вам полезен, пока!
Источник
Метод DoCmd.TransferSpreadsheet (Access)
Метод TransferSpreadsheet выполняет действие TransferSpreadsheet в Visual Basic.
Синтаксис
выражение.TransferSpreadsheet (TransferType, SpreadsheetType, TableName, FileName, HasFieldNames, Range, UseOA)
выражение: переменная, представляющая объект DoCmd.
Параметры
| Имя | Обязательный или необязательный | Тип данных | Описание |
|---|---|---|---|
| TransferType | Необязательный | AcDataTransferType | Нужный тип переноса. Значение по умолчанию — acImport. |
| SpreadsheetType | Необязательный | AcSpreadSheetType | Тип электронной таблицы для импорта, экспорта или связи. |
| TableName | Необязательный | Variant | Строковое выражение, являющееся именем таблицы Office Access, предназначенной для импорта данных электронной таблицы, экспорта данных электронной таблицы или связывания данных электронной таблицы, или запрос на выборку Access, результаты которого нужно экспортировать в электронную таблицу. |
| FileName | Необязательный | Variant | Строковое выражение, являющееся именем и путем электронной таблицы для импорта, экспорта или связывания. |
| HasFieldNames | Необязательный | Variant | Используйте значение True (1), чтобы использовать первую строку электронной таблицы в качестве имен полей при импорте или связывании. Используйте значение False (0), чтобы считать первую строку электронной таблицы обычными данными. Если оставить этот аргумент пустым, предполагается, что используется значение по умолчанию (False). При экспорте таблицы или данных запроса на выборку Access в электронную таблицу имена полей записываются в первую строку электронной таблицы независимо от введенного значения этого аргумента. |
| Range | Необязательный | Variant | Строковое выражение, являющееся допустимым диапазоном ячеек или именем диапазона в электронной таблице. Этот аргумент применяется только для импорта. Чтобы импортировать электронную таблицу целиком, оставьте этот аргумент пустым. При экспорте в электронную таблицу необходимо оставить этот аргумент пустым. Если ввести диапазон, экспорт завершится сбоем. |
| UseOA | Необязательный | Variant | Этот аргумент не поддерживается. |
Примечания
Используйте метод TransferSpreadsheet для импорта или экспорта данных между текущей базой данных Access или проектом Access (ADP) и файлом электронной таблицы. Вы также можете связать данные в электронной таблице Excel с текущей базой данных Access. Это позволит просматривать и изменять данные электронной таблицы с помощью Access, при этом не теряя возможность полного доступа к ним в Excel. Кроме того, вы можете связать данные в файле электронной таблицы Lotus 1-2-3, но они будут доступны в Access только для чтения.
Также можно использовать объекты данных ActiveX (ADO) для создания связи с помощью свойства ActiveConnection для объекта Recordset.
Пример
В следующем примере импортируются данные из указанного диапазона электронной таблицы Lotus Newemps.wk3 в таблицу Employees (Сотрудники) Access. В качестве имен полей используется первая строка электронной таблицы.
Поддержка и обратная связь
Есть вопросы или отзывы, касающиеся Office VBA или этой статьи? Руководство по другим способам получения поддержки и отправки отзывов см. в статье Поддержка Office VBA и обратная связь.
Источник
Subscribe to Developer Soapbox
Stay up to date! Get all the latest & greatest posts delivered straight to your inbox
Export Microsoft Access Data to Excel
Developer
Our resident opinionated developer.
Developer
For this example, we will be using a simple table with a list of beer names. Our goal is to export the contents of this table into an Excel workbook.
Access provides two ways to do this. If you wish to export the entire table, without any frills, Access provides a simple method to export (and import or link) Excel data.
If you need to use some custom logic while exporting though, you can also use VBA’s Excel object model. You will learn both ways in this tutorial.
Test Data
As mentioned, we will use the very simple data below for this tutorial.
The Simple Way
1. Create VBA Procedure
Microsoft Access provides the very handy method DoCmd.TransferSpreadsheet to export, import, or link Excel data. The procedure below shows how to use this method to export our simple table. Create a new VBA Module and paste the code.
2. Run Procedure
Run the procedure and check that the file was created in the path listed in the excel_file_name variable in your procedure. You will notice that the field names were also exported. This is one of the parameters for TransferSpreadsheet , which can be excluded if needed. 
For More Complex Cases
1. Import Excel References
In order to use the Excel object model in VBA, we must first import the Excel object library reference. This can be done by going to Tools->References in the VBA editor menu.
Scroll down to the “Microsoft Excel Object Library” entry (Excel version may vary), check it, and click OK. 
2. Create VBA Procedure
Although the name of the tutorial step is the same, more complex cases require more than a single method. The code below uses VBA’s Excel object model to create a workbook and write to cells within a sheet.
3. Run Procedure
Run the procedure and check that the file was created in the path listed in excelfilename variable for your procedure.
As you can see, we were able to do some customization by using the Excel object model. For example, we were able to append to the text for each record, and format the header font. Basically, anything you can do in Excel can be done in VBA using the object model.
Источник
DEVelopers HUT
Very similarly to my MS Access – VBA – Export Records to Excel post, I found myself needing to easily export a form’s recordset to Excel. Not the underlying table or query, but the filtered, currently viewed recordset. I already had the above code so I made a few very minor tweaks et voila I had a new function that could export, with ease, any recordset to Excel. Hopefully it can help someone else!
As you can see by examining the code it includes Conditional Compiling Directive so you can have it either as Early or Late Binding to suit your preferences.
Furthermore, the following sections of code are completely optional and are simply used to perform some basic formatting (pretty things up and make the worksheet easier to work with IMHO). I’ve left it in place should it be useful to you and also to illustrate how easily you can perform other automations at the same time as performing the export (show some of the syntax). Feel free to remove it as you see fit.
Taking Things Even Further :: ExportRecordset2XLS V2.0!
Now the above functions does exactly as intended, but what if we wanted more flexibility and more control over what is applied depending on the situation! This is the beauty of VBA once you truly get into it, you can develop some true coding gems that can be utilized in all sorts of situations.
So let reexamine the above function, how could we modify it to not need to actually remove sections of code depending on whether or not we want autofilters applies, or freeze panes, …? How could we make if flexible enough to even allow the user to specify an exist workbook to export to, and if none is specified then create a new one. How can we make a universal function?
Surprisingly, with a pretty small number of tweak to the above function we can do all that!
Download
Feel free to download a copy by using the links provided below:
Disclaimer/Notes:
All code samples, download samples, links, . on this site are provided ‘AS IS‘.
In no event will Devhut.net or CARDA Consultants Inc. be liable to the client/end-user or any third party for any damages, including any lost profits, lost savings or other incidental, consequential or special damages arising out of the operation of or inability to operate the software which CARDA Consultants Inc. has provided, even if CARDA Consultants Inc. has been advised of the possibility of such damages.
The YouTube Demo File:
Download “Access — Export to Excel”
The Original Article File:
As requested, feel free to download a fully function sample 2003 mdb of the above code which illustrates how it can be implemented.
Export Recordset To Excel (2K3 mdb)
21 responses on “ MS Access – VBA – Export RecordSet to Excel ”
Sorry I found the error, the Usage you put in the comments isn’t the right name compared to the actual function name: Export2XLS vs ExportRecordset2XLS
The code works great by the way except for one thing. it doesn’t actually copy the data across… The header titles are all right and formatted but there’s no lines of data… Help?
Thank you for the heads up. As you can tell the code evolved over time. I have update the usage to use the proper procedure name now.
I’m trying to use this code Function but having issues. I copied the Function to a ‘module’ – it compiled, no issues. I then added the following code to ‘Report_Open’ and it’s not working –
Dim rst As DAO.Recordset
‘Set rst = Me.Recordset
‘Set rst = Me.Recordset.Clone
(I TRIED EACH TO THE ABOVE (2) ‘SET’ STATEMENTS AND NEITHER WORK.
Call ExportRecordset2XLS(rst)
Any suggestions would be greatly appreciated and thanks for your help!
What happens exactly? Do you receive any error messages?
I just quickly tested and place my code in a standard module and added a button to a random form and tried (using the button’s On Click event)
and both worked fine.
That said, I’m confused by the choice of Event you are trying to use. Normally, you’d call this function from a command button that the user initiates, so the On Click event.
Also, be sure that Excel didn’t open up in the background somewhere. You may need to use some Windows APIs to bring Excel to the forefront when you run this procedure (that’s what I do when I call any external program to ensure it gains the focus and isn’t hidden from the user).
Copied both your suggested functions and noon eo them get past this line
Set oExcel = GetObject(, “Excel.Application”) ‘Bind to existing instance of Excel
gives me a error message
run time error 429 ActiveX component can’t create object
any suggestions
I went to references and added references to anything that resembled the words active X , script & excel
Considering the line right above is a On Error Resume Next statement that extremely odd.
What is your Error Handling Settings?
Tools->Options->General->Error Trapping
It should be set to Break on Unhandled Errors
There is no need to for any References whatsoever. That is the whole point of using Late Binding!
You do have Excel installed on your computer?
error trapping is set to “Break on all errors ” why
OMG…I changed the Break on all errors to either of the other 2 options and now I don’t get an Error abut active X…what on earth does this have to do with Active X 429…Microsoft developers need to get a grip with the error messages ..the ones that have no apparent reference to the real issue and as a result of that they throw you in a complete wrong direction.
Thank for your help as I would never have solved this one…ever in a million years!!
Now were talking your code is amazing ..Love it now have something I can work and play with..
Hi Daniel,
Thanks for all your great Access help and code samples!
Apparently I either don’t understand or passing the sFile info incorrectly. Based on the sFile input variable comment, I assumed if I passed a file path & name the routine would create a new Excel file and export the recordset data. But I am receiving an error when I provide the sFile info. I’m getting the following error info:
Error Number = 1004
Error Description = Sorry, we couldn’t find C:TEMP qryMyTestQuery.xlsx. Is it possible it was moved, renamed or deleted?
The error is on the following line:
Set oExcelWrkBk = oExcel.Workbooks.Open(sFile) ‘Start a new workbook
My test routine:
Private Sub ExportMyData()
Dim db As DAO.Database
Dim rsQuery As DAO.Recordset
Set db = CurrentDb
Set rsQuery = db.OpenRecordset(“qryMyTestQuery”, dbOpenSnapshot)
Call ExportRecordset2XLS(rsQuery, “C:TEMPqryMyTestQuery.xlsx”)
Set rsQuery = Nothing
Set db = Nothing
End Sub
Please help me understand how to correctly utilize the sFile feature.
Again thanks for all your help!
sFile is used to open/append an existing workbook. If you want a new workbbok to be created then you simply omit the sFile input variable.
That said, I think I understand what you would like to happen, that is create a new file, export the data and save it as sFile. I will see what I can do.
You are correct . My thought – if the file exists, then open/append the existing workbook. If the file does not exist, create a new file, export the recordset, and save the file.
The Input Parameter notes implies this functionality:
sFile Optional -> File path and name to update
‘If none is provided a new Excel file is created
Thanks for all you help!
“If none is provided a new Excel file is created Thanks for all you help!”
That’s exactly what it currently does. If you omit the sFile input variable then a new instance of Excel is created with a new blank workbook in which the data is imported. Then it is up to the user as to how/where to save it.
That all said, I like your idea, and will see what I can do at a later date.
Hello Daniel,
I am using your code to export the data to excel worksheet but i have one problem with Richtext.
For ex.
if I have column in database with datatype ‘LongText’ and TextFormat ‘Richtext’ than after exporting to excel it shows me a tags of html Like ‘div’ ‘br’ etc..
How can i export to excel without any such tags?
Can you help me on this.?
Thanks for your input.
Hello Daniel,
Great code, it saves me a lot of time and works great at the first try
Will be embedded in a powershell applet (let’s play the fool)
Thank you! Worked first go!
I really appreciate you sharing this function 🙂
Awesome and thank-you soooo much Daniel, saved a novice like me big time.
Thanks for sharing this little bit of your IP as it is truly appreciated.
Hello everyone,
This function is extremely well made, and it also works with ADO, only one tiny tweak necessary: “ByVal rs As DAO.Recordset” -> “ByVal rs As ADODB.Recordset”.
Many thanks Daniel.
Pierre
Thank you for sharing. I’m sure others will find that option useful.
Thanks for this smart & friendly solution, worked well for me.
Leave a Reply Cancel reply
If you found this site helpful, consider giving a donation to offset the costs to keeping it running and thank you.
My YouTube Channel
Be sure to check out my latest videos on Access, Excel, VBA and more . by visiting:
Источник
Very similarly to my MS Access – VBA – Export Records to Excel post, I found myself needing to easily export a form’s recordset to Excel. Not the underlying table or query, but the filtered, currently viewed recordset. I already had the above code so I made a few very minor tweaks et voila I had a new function that could export, with ease, any recordset to Excel. Hopefully it can help someone else!
'---------------------------------------------------------------------------------------
' Procedure : ExportRecordset2XLS
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Export the passed recordset to Excel
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' rs : Recordset object to export to excel
'
' Usage:
' ~~~~~~
' Call ExportRecordset2XLS(Me.RecordsetClone)
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2017-Mar-13 Initial Release
' 2 2018-09-20 Updated Copyright
'---------------------------------------------------------------------------------------
Function ExportRecordset2XLS(ByVal rs As DAO.Recordset)
'#Const EarlyBind = True 'Use Early Binding, Req. Reference Library
#Const EarlyBind = False 'Use Late Binding
#If EarlyBind = True Then
'Early Binding Declarations
Dim oExcel As Excel.Application
Dim oExcelWrkBk As Excel.WorkBook
Dim oExcelWrSht As Excel.WorkSheet
#Else
'Late Binding Declaration/Constants
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim oExcelWrSht As Object
Const xlCenter = -4108
#End If
Dim bExcelOpened As Boolean
Dim iCols As Integer
'Start Excel
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oExcel = CreateObject("Excel.Application")
bExcelOpened = False
Else 'Excel was already running
bExcelOpened = True
End If
On Error GoTo Error_Handler
oExcel.ScreenUpdating = False
oExcel.Visible = False 'Keep Excel hidden until we are done with our manipulation
Set oExcelWrkBk = oExcel.Workbooks.Add() 'Start a new workbook
Set oExcelWrSht = oExcelWrkBk.Sheets(1)
With rs
If .RecordCount <> 0 Then
.MoveFirst 'This is req'd, had some strange behavior in certain instances without it!
'Build our Header
'****************
For iCols = 0 To rs.Fields.Count - 1
oExcelWrSht.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
'Format the header
With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
oExcelWrSht.Cells(1, iCols))
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
.HorizontalAlignment = xlCenter
End With
'Copy the data from our query into Excel
'***************************************
oExcelWrSht.Range("A2").CopyFromRecordset rs
'Some formatting to make things pretty!
'**************************************
'Freeze pane
oExcelWrSht.Rows("2:2").Select
With oExcel.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
'AutoFilter
oExcelWrSht.Rows("1:1").AutoFilter
'Fit the columns to the content
oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
oExcelWrSht.Cells(1, iCols)).EntireColumn.AutoFit
'Start at the top
oExcelWrSht.Range("A1").Select
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", _
vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
Error_Handler_Exit:
On Error Resume Next
oExcel.Visible = True 'Make excel visible to the user
Set rs = Nothing
Set oExcelWrSht = Nothing
Set oExcelWrkBk = Nothing
oExcel.ScreenUpdating = True
Set oExcel = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ExportRecordset2XLS" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
As you can see by examining the code it includes Conditional Compiling Directive so you can have it either as Early or Late Binding to suit your preferences.
Furthermore, the following sections of code are completely optional and are simply used to perform some basic formatting (pretty things up and make the worksheet easier to work with IMHO). I’ve left it in place should it be useful to you and also to illustrate how easily you can perform other automations at the same time as performing the export (show some of the syntax). Feel free to remove it as you see fit.
'Format the header
With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
oExcelWrSht.Cells(1, iCols))
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
.HorizontalAlignment = xlCenter
End With
and
'Some formatting to make things pretty!
'**************************************
'Freeze pane
oExcelWrSht.Rows("2:2").Select
With oExcel.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
'AutoFilter
oExcelWrSht.Rows("1:1").AutoFilter
'Fit the columns to the content
oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
oExcelWrSht.Cells(1, iCols)).EntireColumn.AutoFit
Taking Things Even Further :: ExportRecordset2XLS V2.0!
Now the above functions does exactly as intended, but what if we wanted more flexibility and more control over what is applied depending on the situation! This is the beauty of VBA once you truly get into it, you can develop some true coding gems that can be utilized in all sorts of situations.
So let reexamine the above function, how could we modify it to not need to actually remove sections of code depending on whether or not we want autofilters applies, or freeze panes, …? How could we make if flexible enough to even allow the user to specify an exist workbook to export to, and if none is specified then create a new one. How can we make a universal function?
Surprisingly, with a pretty small number of tweak to the above function we can do all that!
'---------------------------------------------------------------------------------------
' Procedure : ExportRecordset2XLS
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Export the passed recordset to Excel
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' rs : Recordset object to export to excel
' sFile : Optional -> File path and name to update
' If none is provided a new Excel file is created
' sWrkSht : Optional -> Name of the Worksheet to update
' If sWrkSht is supplied and the sheet does not exist it will be
' created
' lStartCol : Optional -> Column number to start inserting the data into
' If none is supply insert will be start on the 1st Column
' lStartRow : Optional -> Row number to start inserting the data into
' If none is supply insert will be start on the 1st Row
' bFitCols : Optional -> Auto Fit the column to the width of the data contained within
' Default is True
' bFreezePanes : Optional -> Freeze the Header row
' Default is True
' bAutoFilter : Optional -> AutoFilter the data
' Default is True
'
' Usage:
' ~~~~~~
' Call ExportRecordset2XLS(Me.RecordsetClone)
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2017-Mar-13 Initial Release
' 2 2017-Mar-16 Added sFile
' Added sWrkSht
' Added lStartCol
' Added lStartRow
' Added bFitCols
' Added bFreezePanes
' Added bAutoFilter
' 2 2018-09-20 Updated Copyright
'---------------------------------------------------------------------------------------
Function ExportRecordset2XLS(ByVal rs As DAO.Recordset, _
Optional ByVal sFile As String, _
Optional ByVal sWrkSht As String, _
Optional ByVal lStartCol As Long = 1, _
Optional ByVal lStartRow As Long = 1, _
Optional bFitCols As Boolean = True, _
Optional bFreezePanes As Boolean = True, _
Optional bAutoFilter As Boolean = True)
'#Const EarlyBind = True 'Use Early Binding, Req. Reference Library
#Const EarlyBind = False 'Use Late Binding
#If EarlyBind = True Then
'Early Binding Declarations
Dim oExcel As Excel.Application
Dim oExcelWrkBk As Excel.WorkBook
Dim oExcelWrkSht As Excel.WorkSheet
#Else
'Late Binding Declaration/Constants
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim oExcelWrkSht As Object
Const xlCenter = -4108
#End If
Dim bExcelOpened As Boolean
Dim iCols As Integer
Dim lWrkBk As Long
'Start Excel
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oExcel = CreateObject("Excel.Application")
bExcelOpened = False
Else 'Excel was already running
bExcelOpened = True
End If
On Error GoTo Error_Handler
oExcel.ScreenUpdating = False
oExcel.Visible = False 'Keep Excel hidden until we are done with our manipulation
If sFile <> "" Then
Set oExcelWrkBk = oExcel.Workbooks.Open(sFile) 'Start a new workbook
On Error Resume Next
lWrkBk = Len(oExcelWrkBk.Sheets(sWrkSht).Name)
If Err.Number <> 0 Then
oExcelWrkBk.Worksheets.Add.Name = sWrkSht
Err.Clear
End If
On Error GoTo Error_Handler
Set oExcelWrkSht = oExcelWrkBk.Sheets(sWrkSht)
oExcelWrkSht.Activate
Else
Set oExcelWrkBk = oExcel.Workbooks.Add() 'Start a new workbook
Set oExcelWrkSht = oExcelWrkBk.Sheets(1)
If sWrkSht <> "" Then
oExcelWrkSht.Name = sWrkSht
End If
End If
With rs
If .RecordCount <> 0 Then
.MoveFirst 'This is req'd, had some strange behavior in certain instances without it!
'Build our Header
'****************
For iCols = 0 To rs.Fields.Count - 1
oExcelWrkSht.Cells(lStartRow, lStartCol + iCols).Value = rs.Fields(iCols).Name
Next
'Format the header
With oExcelWrkSht.Range(oExcelWrkSht.Cells(lStartRow, lStartCol), _
oExcelWrkSht.Cells(lStartRow, lStartCol + iCols - 1))
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
.HorizontalAlignment = xlCenter
End With
'Copy the data from our query into Excel
'***************************************
oExcelWrkSht.Cells(lStartRow + 1, lStartCol).CopyFromRecordset rs
'Some formatting to make things pretty!
'**************************************
'Freeze pane
If bFreezePanes = True Then
oExcelWrkSht.Cells(lStartRow + 1, 1).Select
oExcel.ActiveWindow.FreezePanes = True
End If
'AutoFilter
If bAutoFilter = True Then
oExcelWrkSht.Rows(lStartRow & ":" & lStartRow).AutoFilter
End If
'Fit the columns to the content
If bFitCols = True Then
oExcelWrkSht.Range(oExcelWrkSht.Cells(lStartRow, lStartCol), _
oExcelWrkSht.Cells(lStartRow, lStartCol + iCols)).EntireColumn.AutoFit
End If
'Start at the top
oExcelWrkSht.Cells(lStartRow, lStartCol).Select
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", _
vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
Error_Handler_Exit:
On Error Resume Next
oExcel.Visible = True 'Make excel visible to the user
Set rs = Nothing
Set oExcelWrkSht = Nothing
Set oExcelWrkBk = Nothing
oExcel.ScreenUpdating = True
Set oExcel = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ExportRecordset2XLS" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Download
Feel free to download a copy by using the links provided below:
Disclaimer/Notes:
All code samples, download samples, links, … on this site are provided ‘AS IS‘.
In no event will Devhut.net or CARDA Consultants Inc. be liable to the client/end-user or any third party for any damages, including any lost profits, lost savings or other incidental, consequential or special damages arising out of the operation of or inability to operate the software which CARDA Consultants Inc. has provided, even if CARDA Consultants Inc. has been advised of the possibility of such damages.
The YouTube Demo File:
Download “Access — Export to Excel”
Export2Excel.zip – Downloaded 561 times – 53.08 KB
The Original Article File:
As requested, feel free to download a fully function sample 2003 mdb of the above code which illustrates how it can be implemented.
Export Recordset To Excel (2K3 mdb)
How to Export Access Data to Excel using VBA Code?
Creating a VBA tool in MS Access is always better as compare to MS Excel. MS Access provides better user interface and ability to handle multiple users. Still people prefer to pull and see the reports in MS Excel. Below VBA code helps you to export MS Access data into MS Excel.
Public Function ExportToExcel()
'Variable declaration
Dim strQuery As String
Dim lCounter As Long
Dim rsRecordset As Recordset
Dim objExcel As Object
Dim wkbReport As Object
Dim wksReport As Object
'Create new excel file
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set wkbReport = objExcel.Workbooks.Add
Set wksReport = wkbReport.Worksheets(1)
'Set the query
strQuery = "SELECT * from tblDummyData"
'Execute the query on the database
On Error GoTo Error_Query
Set rsRecordset = CurrentDb.OpenRecordset(strQuery)
On Error GoTo 0
'Add header in row 1 of Excel sheet
For lCounter = 0 To rsRecordset.Fields.Count - 1
wksReport.Cells(1, lCounter + 1).Value = rsRecordset.Fields(lCounter).Name
Next
'Export data to Excel sheet
wksReport.Cells(2, 1).CopyFromRecordset rsRecordset
'Auto fit Excel columns to adjust as per data
wksReport.Cells.EntireColumn.AutoFit
'Close the objects
Set rsRecordset = Nothing
Set wksReport = Nothing
Set wkbReport = Nothing
'Show the message to user
MsgBox "Done"
Exit Function
'Error handler if query does not execute
Error_Query:
MsgBox "Error: " & Err.Description, vbCritical
Exit Function
End Function
Export Access Data to Excel using VBA Code follow below steps:-
1. Open an MS Access file
2. Press Alt+F11
3. Insert a Module (Insert>Module) from menu bar
4. Paste the code in the module
5. We also need to create a dummy table using Create>Table Design menu
6. Now add few fields in the table and save the table with tblDummyData name
7. Add dummy data in the table
8. Now add a new form in MS Access using Create>Form Design menu
9. Change the following properties of the form
Auto Center: Yes
Record Selectors: No
Navigation Buttons: No
Scroll Bars: Neither
Pop Up: Yes
10. Add a Button from Design menu
11. Change the following properties of the control
Name: cmdExport
Caption: Export Data into Excel
12. Create an Event Procedure of On Click event
13. Click on ‘…’ to create the procedure in VBA screen
14. Add the following code in the click event procedure
Call Module1.ExportToExcel
15. Done, now right click on the form and select Open
16. Click on the ‘Export Data into Excel’
Download Practice File
You can also practice this through our practice files. Click on the below link to download the practice file.
Recommended Articles
- Create Pareto Chart In Excel
- How to find duplicates in excel?
- VBA to Read Excel Data using Connection String
- Few Simple Excel Tips – Excel Learner Should Know
- Lock Cells to avoid editing, Hide Formulas
Excel VBA Course : Beginners to Advanced
We are offering Excel VBA Course for Beginners to Experts at discounted prices. The courses includes On Demand Videos, Practice Assignments, Q&A Support from our Experts. Also after successfully completion of the certification, will share the success with Certificate of Completion
This course is going to help you to excel your skills in Excel VBA with our real time case studies.
Lets get connected and start learning now. Click here to Enroll.
Secrets of Excel Data Visualization: Beginners to Advanced Course
Here is another best rated Excel Charts and Graph Course from ExcelSirJi. This courses also includes On Demand Videos, Practice Assignments, Q&A Support from our Experts.
This Course will enable you to become Excel Data Visualization Expert as it consists many charts preparation method which you will not find over the internet.
So Enroll now to become expert in Excel Data Visualization. Click here to Enroll.