Copyfromrecordset in excel vba

Всем привет! Материал сегодня будет посвящен рассмотрению возможности 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.

Код 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 у нас может выступать любой запрос, а не только данные формы.

На этом у меня все! Надеюсь, материал был Вам полезен, пока!