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.