Export to Word
acCmdOutPutToRTF
Exports an object to Word, saves it as a Word document rather than an RTF file. It deletes the RTF file that the export creates.
'***************** Code Start *******************
' This code was originally written by Terry Wickenden.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
Sub ExportToRTF(strName As String, strPath As String, Optional strItem As String = "Report")
' Expects the name of the item to be exported = strName
' Expects the full file name for the word document = strPath eg F:\Terry\Test.Doc
' Also looks for type of object to be exported = strItem
' Defaults to Report - other valid entries are Form, Table, Query
' Note:- These are all case sensitive
Dim intType As Integer
Dim strMsg As String
Dim strRtfFile As String
Dim wdApp As Word.Application
On Error GoTo ErrExportToRTF
Select Case strItem
Case "Report"
intType = acReport
Case "Query"
intType = acQuery
Case "Form"
intType = acForm
Case "Table"
intType = acTable
Case Else
MsgBox "Invalid object type", vbCritical, "Entry Error"
Exit Sub
End Select
'Start Word - easier to handle this way
Set wdApp = CreateObject("Word.Application")
'Select the object in the database window
DoCmd.SelectObject intType, strName, True
'Output the document to word
DoCmd.RunCommand acCmdOutputToRTF
'Find the RTF name and path
strRtfFile = wdApp.ActiveDocument.FullName
'Save the document as a Word document in the required place
wdApp.ActiveDocument.SaveAs strPath, wdFormatDocument
'Close Word and tidy up
wdApp.Quit
Set wdApp = Nothing
'Delete the RTF file as it is not now needed
Kill strRtfFile
Exit Sub
ErrExportToRTF:
Select Case Err
Case 75
'File not available - Word has not cleaned up properly yet for Kill to work
Resume 0
Case 2544
'Invalid object name
strMsg = "There is no " & strItem & " called " & strName & "."
MsgBox strMsg, vbCritical, "Entry Error"
Exit Sub
Case Else
MsgBox Err & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error Message"
Exit Sub
End Select
End Sub
'****************** Code End ********************
