04. Данный пример показывает как можно создать таблицу в Microsoft Word, используя vba в Word. При этом создается соединение внутри документа Word. Обратите внимание, что функция InsertDatabase отличается параметрами в разных версиях офиса.
Option Compare Database
Option Explicit
'#Const AccessVer = 2000
'#Const AccessVer = 2002
#Const AccessVer = 2003
'***************************************************************
'04.Пример. Как создать таблицу в документе Word ?
'***************************************************************
'==============================================================
' Создание таблицы в документе Word
' ---------------------------------
' Для этого Вы должны создать в шаблоне la_automat.dot
' закладку с имеенем Таблица. Например,
' Вставка - Закладка ... - Имя закладки=Таблица
' (Нажмите кнопку Добавить и сохраните шаблон)
'
Private Sub butNewWord_Click()
Dim app As Word.Application 'Приложение программы
Dim strDOC As String ' Имя документа
Dim strDOT As String ' Имя шаблона
Dim strMDB As String ' Имя базы данных
Dim rng As Word.Range ' Область данных
Dim tbl As Word.Table ' Таблица документа
Dim c As Word.Cell ' Ячейка таблицы
Dim i As Long ' Переменная
On Error GoTo 999
' Определяем имена шаблона, документа и базы данных
With Application.CurrentProject
strDOT = .Path "" "la_automat.dot"
strDOC = .Path "" "la_automat.doc"
strMDB = .Path "" .Name
End With
' Управление документом Word
Set app = New Word.Application 'Новое приложение Word
app.Visible = True 'Отображаем документ
app.Documents.Add strDOT 'Добавляем шаблон
' Выбираем закладку (позицию) таблицы
Set rng = app.ActiveDocument.Bookmarks("Таблица").Range
With rng
.Collapse wdCollapseEnd
' Вставляем таблицу, используя запрос из базы данных
#If AccessVer = 2000 Then
.InsertDatabase _
Style:=191, _
LinkToSource:=False, _
Connection:="Query ЗапросПримера04", _
DataSource:=strMDB
#ElseIf AccessVer = 2002 Then
.InsertDatabase Format:=0, Style:=0, LinkToSource:=False, _
Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" strMDB ";Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engi" _
, SQLStatement:="SELECT * FROM `ЗапросПримера04`" "", PasswordDocument _
:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", DataSource:= _
strMDB, From:=-1, To:=-1, _
IncludeFields:=True
#Else
.InsertDatabase Format:=0, Style:=0, LinkToSource:=False, _
Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" strMDB ";Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLE" _
, SQLStatement:="SELECT * FROM `ЗапросПримера04`" "", PasswordDocument _
:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", DataSource:= _
strMDB, From:=-1, To _
:=-1, IncludeFields:=True
#End If
i = .Tables.Count ' Всего таблиц в данной области
Set tbl = .Tables(i) ' Созданная таблица
' Форматируем всю таблицу
tbl.Range.Font.Size = 10 ' Выбираем шрифт
tbl.AutoFormat wdTableFormatGrid8 ' Выбираем авто-формат
' Вставляем колонку в начало таблицы
tbl.Columns.Add tbl.Columns(1) ' Добавляем колонку
i = 0
For Each c In tbl.Range.Columns(1).Cells
If i Then
' Изменяем данные
c.Range.InsertAfter Format(i, "000") ' Вставить данные
c.Range.ParagraphFormat.Alignment = wdAlignParagraphRight 'Правый формат
Else
' Изменяем заголовок ячейки
tbl.Range.Columns(1).Cells(1).Range.Text = "Пункт"
End If
i = i + 1
Next c
' Форматируем заголовок, т.е. всю строку
tbl.Rows(1).Select ' Выбираем заголовок
With app.Selection
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Font.Name = "Arial" ' Имя шрифта
.Font.Size = 10 ' Размер шрифта
End With
' Добавляем новую строку
tbl.Rows.Add ' Добавляем строку в конец таблицы
With tbl.Cell(tbl.Rows.Count, 1) ' Выбираем 1 ячейку строки
.Formula "=SUM(ABOVE)" ' Устанавливаем формулу
.Shading.BackgroundPatternColorIndex = wdDarkRed ' Назначаем цвет фона
.Range.Font.Bold = True ' Толщина (вес) текста
End With
End With
app.ActiveDocument.SaveAs strDOC ' Сохраняем файл
' app.Quit 'Закрываем приложение
Exit Sub
999:
MsgBox Err.Description 'Ошибка
Err.Clear
app.Quit
End Sub
What you need to do is to first open a new instance of Word from Access. This is done by the following command:
Set wrdApp = CreateObject("Word.Application")
Then to make it visible and to add a document, you use this object from that point on:
wrdApp.Visible = True
Set myDoc = wrdApp.Documents.Add 'Here you should also keep the new document as an object so you can directly refer to it
Or if you use a template you need to open it instead:
wrdApp.Visible = True
Set myDoc = wrdApp.Documents.Open ("C:databasetemplate.docx")
And then comes your code that you need to modify accordingly to the above:
For iCount = 0 To numberOfTables - 1
myDoc.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With myDoc.ActiveWindow.Selection.Tables(1)
'Note here that for the Selection object you need to refer to the active window
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
'.ApplyStyleRowBands = True 'Office 2010
'.ApplyStyleColumnBands = False 'Office 2007
End With
myDoc.ActiveWindow.Selection.EndKey Unit:=wdStory
myDoc.ActiveWindow.Selection.TypeParagraph
Next iCount
This should get you started.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 |
Public Sub WordA(SelectOrderID) ' Передача данных в Microsoft Word ' Описание рабочих переменных Dim B, C, F, D, E Dim a As Variant Dim s$, i% a = Date ' Объект Word Dim oWord As Object Dim DSset As ADODB.Recordset ' Набор данных Set DSset = New ADODB.Recordset ' Процедура находится в модуле ModuleSlave ' SelectDateTreaty - Дата ' DayMonthYear - Дата прописью ' Создание объекта MS Word Set oWord = CreateObject("Word.Application") ' Сделать окно MS Word видимым oWord.Visible = True ' Заголовок окна MS Word oWord.Caption = "Заказ-наряд на проведение проверки качества " oWord.Documents.Add ' Ориентация книжная бумага А4 ' Поля (1 см = 28 пунктов) With oWord.ActiveDocument.PageSetup .LineNumbering.Active = False .Orientation = wdOrientPortrait .LeftMargin = 48 .RightMargin = 40 .TopMargin = 56 .BottomMargin = 56 End With With oWord.ActiveDocument .AutoHyphenation = True .HyphenateCaps = True .ConsecutiveHyphensLimit = 0 End With With oWord.Selection .Font.Bold = True .Font.Name = "Times New Roman" .Font.Size = 11 .ParagraphFormat.Alignment = wdAlignParagraphJustify .TypeText ("Заказ-наряд от " & a) .TypeParagraph .TypeText ("ООО Сервисный центр тел. +7 800 7707 888") .TypeParagraph .Font.Bold = False .Font.Size = 9 .ParagraphFormat.Alignment = wdAlignParagraphJustify .TypeText ("Юридический адрес 143909, Московская область, г.Балашика, ул.Звездная, д.76, пом 418") .TypeParagraph .TypeText ("Адрес филиала: инд 195220 г. Санкт-Петербург пр. Науки 21 к.1") .TypeParagraph .Font.Underline = True .TypeText ("Основание: Расходная накладная от 29.05.2015") .TypeParagraph .Font.Bold = True .Font.Size = 11 With DSset .Source = "SELECT OrderID, FamilyName, FirstName, SecondName, Object, Dates, DueDate, Cost, Phone " & _ "FROM tblOrder " & _ "WHERE OrderID = " & SelectOrderID .ActiveConnection = CurrentProject.Connection .CursorType = adOpenKeyset .Open D = !OrderID F = !FamilyName B = !FirstName C = !Phone E = "Покупатель: " & F & (" " + B) End With .TypeText (E) .TypeParagraph .Font.Bold = False .Font.Size = 9 .Font.Underline = False .TypeText ("Сот. :" & C) DSset.Close End With '====================================================================== 'Пошла табличка:. oWord.Selection.TypeParagraph oWord.ActiveDocument.Tables.Add oWord.Selection.Range, 2, 4, 1, 0 'oWord.ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _ 4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitFixed With oWord.Selection.Tables(1) If .Style <> "Table Grid" Then .Style = "Table Grid" End If .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False End With oWord.Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=28.1, RulerStyle:= _ wdAdjustFirstColumn oWord.Selection.Tables(1).Columns(2).SetWidth ColumnWidth:=63.8, RulerStyle:= _ wdAdjustFirstColumn oWord.Selection.Tables(1).Columns(3).SetWidth ColumnWidth:=255.15, RulerStyle:= _ wdAdjustFirstColumn oWord.Selection.TypeText Text:="№" oWord.Selection.MoveRight Unit:=wdCell oWord.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend oWord.Selection.Cells.Merge oWord.Selection.TypeText Text:="Наименование Товара" oWord.Selection.MoveRight Unit:=wdCell oWord.Selection.TypeText Text:="Серийный Номер" s = "SELECT * FROM Item WHERE OrderID=" & SelectOrderID With DSset .Source = s .ActiveConnection = CurrentProject.Connection .CursorType = adOpenKeyset .Open Do While Not .EOF ' i = i + 1 With oWord.Selection .MoveRight 12 ' Unit:=wdCell .TypeText CStr(i) .MoveRight 12 ' Unit:=wdCell .TypeText "123456789" '???? !!!! .MoveRight 12 ' Unit:=wdCell 'Debug.Print DSset!ItemName .TypeText CStr(DSset!ItemName) .MoveRight 12 ' Unit:=wdCell .TypeText "1234567890серийный" '???? !!!! End With .MoveNext Loop .Close End With oWord.Selection.MoveDown Unit:=wdLine, Count:=1 End Sub |
Всем привет, сегодня мы поговорим о том, как можно выгрузить данные из Access в такие приложения как Word и Excel. Но не о стандартном способе, который есть в Access (связь с Office), а о способе, который позволяет выгружать данные в заданный шаблон как в Word, так и в Excel.
Другими словами, это нужно тогда, когда создать отчет в Access по шаблону, который уже существует, например, в Word, невозможно или слишком трудоемко. Как Вы знаете, отчет в Access может выводиться просто коряво или, самый распространенный вариант, это когда много текста, который в отчете Access не так хорошо форматируется как в Word, а данных не так много, но отчет необходимо автоматизировать, например это какие-то договора, заявления и так далее.
Использование слияния из самого Word-а не очень удобно, поэтому сегодня я расскажу, как можно заполнять такие шаблоны напрямую из Access, путем нажатия на одну кнопку.
Кроме выгрузки в шаблон Word, иногда возникает и необходимость выгрузки в шаблон Excel, и этот способ мы тоже сегодня рассмотрим.
Содержание
- Экспорт данных из Access в шаблон Word
- Код VBA для выгрузки данных в шаблон Word
- Экспорт данных из Access в шаблон Excel
- Код VBA для выгрузки данных в шаблон Excel
Вся разработка делится на две части, это:
- Настройка шаблона Word;
- Настройка выгрузки данных в шаблон.
Суть настройки шаблона заключается в том, чтобы проставить необходимые поля в тех местах шаблона, где нужно выводить те или иные данные. Это делается с помощью полей формы.
Примечание! Я использую Microsoft Word 2003.
Открываем шаблон Word, для начала добавим необходимую панель инструментов, для этого нажимаем «Вид -> Панель инструментов» и ставим галочку «Формы». Теперь у Вас отобразилась панель инструментом «Формы». Все, что осталось сделать — это вставить в местах, в которых необходимо выводить данные, элементы «Текстовое поле», которые доступны на только что добавленной панели инструментов.
После добавления поля, у Вас появится серая область, которая свидетельствует о том, что поле добавлено. Теперь необходимо задать имя этого поля, для того чтобы потом из access вставлять в него значения (стандартное названия не очень удобное). Для этого щелкните правой кнопкой мыши по полю и нажмите «Свойства». В поле закладка напишите желаемое имя этого поля, я в примере назвал его MyTestPole.

Создайте столько полей, сколько Вам нужно.
На этом настройка шаблона закончена, рекомендую сделать этот шаблон только для чтения, а то пользователь возьмет, сформирует документ и сохранит его, и шаблон тем самым потеряется, а если сделать его только для чтения, то у него такой возможности не будет, только сохранять через «Сохранить как».
Переходим к более интересной задачи, это к реализации самой выгрузки из Access в этот шаблон на VBA.
Примечание! Я использую Access в связке с MS SQL 2008, поэтому и данные буду брать от туда.
Код VBA для выгрузки данных в шаблон Word
Допустим, у Вас есть форма, сделайте на ней кнопку (я назвал ее testbutton) и в событие нажатие кнопки вставьте следующий код VBA:
Private Sub testbutton_Click()
'Объявляем переменные
Dim FileDialog As FileDialog
Dim rsd As ADODB.Recordset
Dim strSQL As String
Dim WordApOb As Object
Dim WordOb As Object
Dim path As String
Set rsd = New ADODB.Recordset
'запрос к базе данных для получения необходимых данных
strSQL = "select * from dbo.table where KOD = " & Me.kod & ""
rsd.open strSQL, CurrentProject.Connection
'Выбираем шаблон
Set FileDialog = Application.FileDialog(msoFileDialogOpen)
'убираем множественный выбор, он нам не нужен
FileDialog.AllowMultiSelect = False
'очистим и установим фильтры
FileDialog.Filters.Clear
FileDialog.Filters.add "Word", "*.doc"
'установим фильтр по умолчанию
FileDialog.FilterIndex = 1
'проверяем, что сделал user, если выбрал шаблон, то начинаем работу
If FileDialog.Show = False Then
'Если нет, то выходим
Set dlgFile = Nothing
Exit Sub
End If
'получаем путь к файлу
path = Trim(FileDialog.SelectedItems(1))
'Очистим переменную
Set FileDialog = Nothing
If path <> "" Then
'Будем отслеживать ошибки
On Error GoTo Err_testbutton_Click
'Создаем объект Word
Set WordOb = CreateObject("Word.document")
'Задаем нашему документу значение из шаблона
Set WordOb = GetObject(path)
'Задаем значение объекту word.Application
Set WordApOb = WordOb.Parent
'делаем приложение word видимым
WordApOb.Visible = True
'ищем наше поле в шаблоне
WordOb.Bookmarks("mytestpole").Select
'задаем ему новое значение из нашего Recordset
WordApOb.Selection.TypeText Text:=Nz(rsd.Fields("field").Value, " ")
'и так далее по всем полям
'в конце перейдем на начало нашего документа
WordApOb.Selection.Goto wdGoToFirst
'и активируем его
WordApOb.Activate
'Очистим переменные
Set WordOb = Nothing
Set WordApOb = Nothing
Exit_testbutton_Click:
Exit Sub
Err_testbutton_Click:
MsgBox Err.Description
'в случае ошибки будем делать следующие
'закроем word без сохранения
WordOb.Close (wddonotsavechanges)
WordApOb.Quit
'и также очистим переменные
Set WordOb = Nothing
Set WordApOb = Nothing
Resume Exit_testbutton_Click
End If
End Sub
Код прокомментирован, поэтому сложностей возникнуть не должно. Здесь весь смысл сводится к созданию объекта word.document и word.application. А после мы уже работаем с нашими объектами, т.е. заполняем их.
Экспорт данных из Access в шаблон Excel
В шаблоне Excel уже не нужно создавать поля как в Word, так как здесь мы уже будем ориентироваться по адресам ячеек.
Существует несколько способов, как заполнять Excel шаблон, я опишу два, первый — это тогда, когда Вам просто необходимо проставить несколько полей, т.е. в источнике данных будет всего одна строка с несколькими столбцами. Второй — это когда строк будет уже несколько, причем Вы не знаете, сколько именно (в зависимости от каких то условий). В шаблоне по умолчанию отведено для этого все пару строк, поэтому мы будем нужные нам строки добавлять, для того чтобы наши данные не накладывалась на строки ниже (допустим там примечание, подпись руководителя и т.д.). И совет, я здесь, для примера, использую всего один источник данных, а Вы, если Вам необходимо заполнить шапку, примечание и некое количество строк (т.е. область данных), можете использовать несколько источников (Recordset).
Код VBA для выгрузки данных в шаблон Excel
Сначала добавьте кнопку на форму (я ее назвал testexcel) и вставьте следующий код в событие «Нажатие кнопки».
Private Sub testexcel_Click()
'Объявляем переменные
Dim XL As Object
Dim XLT As Object
Dim newrow As Object
Dim rsd As ADODB.Recordset
Dim strSQL As String
Set rsd = New ADODB.Recordset
'Запрос к базе данных
strSQL = "select * from dbo.table where kod = " & Me.kod & ""
rsd.open strSQL, CurrentProject.Connection
'Создаем необходимые объекты
Set XL = CreateObject("Excel.Application")
'для примера показываю, как можно сразу загружать шаблон без выбора
Set XLT = XL.Workbooks.open("C:testfile.xls")
'1 способ - если в источнике данных всего одна строка
With XLT.Worksheets("Лист1")
.[a1] = rsd.Fields("field1")
.[b1] = rsd.Fields("field2")
.[c1] = rsd.Fields("field3")
.[d1] = rsd.Fields("field4")
End With
'2 способ - если строк в источнике несколько
'причем мы учтем то, что у нас есть шапка и примечание в Excel
'и мы не знаем, сколько строк у нас вставится
'и поэтому строки будем добавлять в случае необходимости
'зададим, с какой строки будем начинать вставлять данные
Rowss = 10
'для нумерации
numrow = 1
'запускаем цикл, он будет работать до тех пор, пока не закончатся строки в нашем источнике
While Not (rsd.EOF)
'смотрим, если строк больше чем мы задали в шаблоне
If Rowss >= 12 Then
'то добавляем строку
XLT.Worksheets("Лист1").Rows(Rowss).Insert
'Запомним нашу строку
Set newrow = XLT.Worksheets("Лист1").Rows(Rowss)
'и вставим туда копию предыдущей строки
'для того если вдруг у вас там есть объединенные ячейки или какие-то нужные данные
'так как новая строка создастся без всяких объединений и значений
XLT.Worksheets("Лист1").Rows(Rowss - 1).Copy newrow
'это просто для примера как можно очистить некий диапазон внутри документа
'XLT.Worksheets("Лист1").Range("A10:F10").ClearContents
'динамически формируем адрес нужной ячейки
cell = "a" & Rowss
'и задаем ей значение
XLT.Worksheets("Лист1").Range(cell) = numrow
cell = "b" & Rowss
XLT.Worksheets("Лист1").Range(cell) = rsd.Fields("field5").Value
'переходим на следующую строку
Rowss = Rowss + 1
'переходим на следующую строку в источнике данных
rsd.MoveNext
Else
'а это выполняется до тех пор, пока не закончатся заданные строки в шаблоне
'т.е. если строк в источнике всего 1, то в код, который выше мы даже не попадем
cell = "a" & Rowss
XLT.Worksheets("Лист1").Range(cell) = numrow
cell = "b" & Rowss
XLT.Worksheets("Лист1").Range(cell) = rsd.Fields("field5").Value
Rowss = Rowss + 1
rsd.MoveNext
End If
'для нумерации
numrow = numrow + 1
'конец цикла
Wend
'это просто пример как можно удалить строку целиком
'XLT.Worksheets("Лист1").Rows(20).Delete
'делаем Excel видимым
XL.Visible = True
'Очищаем переменные
Set XL = Nothing
Set XLT = Nothing
Set newrow = Nothing
End Sub
Здесь я также все подробно прокомментировал, но если есть вопросы, то задавайте их в комментариях к данной статье.
Для сведения, я здесь при создании объекта и Word.Application и Excel.Application использовал позднее связывание, для того чтобы не добавлять необходимые библиотеки и обеспечить совместимость.
Надеюсь, мои примеры Вам помогут!
Similarily to my post regarding exporting records to MS Excel, below is some sample code that illustrates how one can export data into a new Word document (in a table structure). The code determines the necessary rows and columns based on the table or query passed to it and then does the rest. You can easily from this simple example get into formatting fonts, etc…
'---------------------------------------------------------------------------------------
' Procedure : Export2DOC
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Export a recordset to a MS Word table in a new document
' Note : Overwrites file if it already exists without any warning, so you may wish
' to add a check prior to calling this function
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sQuery : Name of the Table or Query to Export the data from
' sFileName : Path and Filename to save the Word Document as
' bOpenDocument : Leave the document open to the users or not (close after generating)
'
' Usage:
' ~~~~~~
' Export2DOC "Contacts", "C:Temptesting01.docx"
' Export2DOC "IncomingOrders", "C:Temporders.docx", True
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2012-Apr-23 Initial Release
' 2 2020-04-08 Updated proc header
' Added sFileName and bOpenDocument arguments
' Added PageSetup.Orientation to proc
' Fixed a bug in the table row count
' Updated and expanded the error handler
'---------------------------------------------------------------------------------------
Function Export2DOC(sQuery As String, _
sFileName As String, _
Optional bOpenDocument As Boolean = False)
Dim oWord As Object
Dim oWordDoc As Object
Dim oWordTbl As Object
Dim bWordOpened As Boolean
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim iCols As Integer
Dim iRecCount As Integer
Dim iFldCount As Integer
Dim i As Integer
Dim j As Integer
Const wdPrintView = 3
Const wdWord9TableBehavior = 1
Const wdAutoFitFixed = 0
' Const wdOrientPortrait = 0
Const wdOrientLandscape = 1
'Start Word
On Error Resume Next
Set oWord = GetObject("Word.Application") 'Bind to existing instance of Word
If Err.Number <> 0 Then 'Could not get instance of Word, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oWord = CreateObject("Word.application")
bWordOpened = False
Else 'Word was already running
bWordOpened = True
End If
On Error GoTo Error_Handler
oWord.Visible = False 'Keep Word hidden until we are done with our manipulation
Set oWordDoc = oWord.Documents.Add 'Start a new document
'Not strictly necessary, but for larger tables switching to Landscape can be very beneficial!
' so the next line demonstrates how that can easily be done
oWordDoc.PageSetup.Orientation = wdOrientLandscape
'Open our SQL Statement, Table, Query
Set db = CurrentDb
Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query
'Switch to print preview mode (not req'd just a personal preference)
oWord.ActiveWindow.View.Type = wdPrintView
'Create the basic table
oWord.ActiveDocument.Tables.Add oWord.selection.Range, _
iRecCount + 1, _
iFldCount, _
wdWord9TableBehavior, _
wdAutoFitFixed
Set oWordTbl = oWordDoc.Tables(1)
'Build our Header Row
For i = 0 To iFldCount - 1
oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name
Next i
'Build our data rows
For i = 1 To iRecCount
For j = 0 To iFldCount - 1
oWordTbl.Cell(i + 1, j + 1) = Nz(rs.Fields(j).Value, "")
Next j
.MoveNext
Next i
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", _
vbCritical + vbOKOnly, "No data to generate an Word spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
oWordDoc.SaveAs (sFileName) 'Save and close
If bOpenDocument = False Then
oWordDoc.Close
' Close Word if is wasn't originally running
If bWordOpened = False Then
oWord.Quit
End If
End If
Error_Handler_Exit:
On Error Resume Next
rs.Close
Set rs = Nothing
Set db = Nothing
oWord.Visible = True 'Make Word visible to the user
Set oWordTbl = Nothing
Set oWordDoc = Nothing
Set oWord = Nothing
Exit Function
Error_Handler:
If Err.Number = 5148 Then
MsgBox "Your Table/Query contains a total of " & iFldCount & " fields/columns, but Word tables can only support a maximum of 63. " & _
"Please change your Table/Query to only supply a maximum of 63 fields/columns and try again.", _
vbCritical Or vbOKOnly, "Operation Aborted"
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Export2DOC" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
End If
Resume Error_Handler_Exit
End Function
You may also wish to review my MS Access Sample- Export Data to Excel and/or Word.

