UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> ConvertToWordDoc    

This function uses Word Automation to convert a file to a Word Document Format. Theoretically, any document that is a) openable via Word and b) saveable as a Word document can be used by this function.

The process is completely transparent to the user: If Word is not already open, there will be no visible indication that the application is performing any processing. If Word is already open, the file is opened hidden and saved without prompt, and then closed, leaving the Word application open with the previously active document showing.

The function uses late binding of the Word Object Model and should be consistent throughout most versions. Created and tested using Access 2003 and Word 2007, and although not yet tested the Automation is expected to work for Word 2000 and newer.


Future Enhancements: The function is missing at least two possible validation checks:

  1. If there is already a document open that has the same name as the Output File, the procedure may fail. This condition has not been tested. It can be verified during the same loop that checks for the Input File already being open.
  2. If the Output File already exists and the user instructs to overwrite it, the existing file is deleted immediately before saving the new file. There is currently no validation to ensure that the existing file deletion was successful.



CODE

'==============================================================================
' Code courtesy of UtterAccess Wiki
' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' NAME: ConvertToWordDoc
' DATE: 8/12/2011
' REV 1.0: Initial Release
'
' Converts an RTF (or any other word-openable file) to a word document
'
' Access 2002+ (or an InStrRev replacement for earlier versions)
' Requires MS Word installed on the machine, or
'   to run Word from an application server, comment out the GetObject() lines
'   and pass the second argument of the CreateObject() function as the server name
'
' Operates by creating an instance of Word, opening the file and saving
'   as a word doc.
'
' Returns True on success, False on error
'
' PARAMETERS:
'   sFileIn: Full path to the file to be converted to .doc
'   sFileOut: Full path of the converted file
'   bPromptOverwrite: True to prompt the overwriting of an existing FileOut
'   bDeleteSourceFile: True to delete the source file after converting
'==============================================================================
Public Function ConvertToWordDoc( _
     sFileIn As String, _
     sFileOut As String, _
     Optional bPromptOverwrite As Boolean = True, _
     Optional bDeleteSourceFile As Boolean = False _
     ) As Boolean
On Error GoTo Error_Proc
Dim Ret As Boolean
'=========================
 Dim oWord As Object             'the Word Application
 Dim sDocName As String          'name of the doc per oWord.Documents(index).Name
                                 'this is updated to the new filename after SaveAs
 Dim bKillExisting As Boolean    'True if overwriting an existing file
 Dim bWordWasOpen As Boolean     'True if word was already open (won't close app)
 Dim bDocAlreadyOpen As Boolean  'True if sDocName was already found (will msg and exit)
 Dim i As Integer                'various/counter
'=========================

 'make sure the sFileIn is valid
 If Len(Dir(sFileIn)) = 0 Then
   MsgBox "File: " & sFileIn & " not found", vbInformation, "File Not Found"
   GoTo Exit_Proc
 End If
 
 'prompt overwrite if required
 If Len(Dir(sFileOut)) <> 0 Then
   If bPromptOverwrite Then
     If MsgBox("Overwrite existing '" & sFileOut & "'?" _
               , vbInformation + vbOKCancel, "Confirm") = vbCancel Then
       GoTo Exit_Proc
     End If
     
     bKillExisting = True
   End If
 End If
 
 'get/create the word app
 On Error Resume Next
 Set oWord = GetObject(, "Word.Application")
 If Err.Number = 0 Then bWordWasOpen = True
 Err.Clear
 On Error GoTo Error_Proc
 If oWord Is Nothing Then
   Set oWord = CreateObject("Word.Application")
 End If
 
 'get the doc name to be opened and make sure there's not
 'a doc already opened with the same name
 sDocName = Right(sFileIn, Len(sFileIn) - InStrRev(sFileIn, "\"))
 If oWord.Documents.Count <> 0 Then
   For i = 1 To oWord.Documents.Count
     If oWord.Documents(i) = sDocName Then
       bDocAlreadyOpen = True
     End If
   Next
 End If
 
 'exit if doc is already open
 If bDocAlreadyOpen Then
   MsgBox "The Document '" & sDocName & "' must be closed to proceed", vbInformation, "Close Document"
   GoTo Exit_Proc
 End If
 
 'open the file
 oWord.Documents.Open _
     FileName:=sFileIn, _
     Visible:=False, _
     ReadOnly:=False, _
     AddToRecentFiles:=False
 DoEvents
 
 'save the file
 If bKillExisting Then
   Kill sFileOut
   DoEvents: DoEvents: DoEvents
 End If
 oWord.Documents(sDocName).SaveAs _
     FileName:=sFileOut, _
     FileFormat:=0, _
     AddToRecentFiles:=True
 DoEvents

 'update sDocName to the new file
 sDocName = Right(sFileOut, Len(sFileOut) - InStrRev(sFileOut, "\"))

 'close the file
 oWord.Documents(sDocName).Close
 
 'close the app if it wasn't already open
 If bWordWasOpen = False Then
   oWord.Quit
 End If
 
 If bDeleteSourceFile Then Kill sFileIn
 DoEvents
 
 Ret = True
'=========================
Exit_Proc:
 Set oWord = Nothing
 ConvertToWordDoc = Ret
 Exit Function
Error_Proc:
 MsgBox "Error: " & Trim(str(Err.Number)) & vbCrLf & _
   "Desc: " & Err.Description & vbCrLf & vbCrLf & _
   "Module: modFileConversions, Procedure: ConvertToWordDoc" _
   , vbCritical, "Error!"
 Resume Exit_Proc
 Resume
End Function


Creative Commons License
ConvertToWordDoc by UtterAccess Wiki is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
Editing and revision of the content is freely encouraged; for details, see Expected Usage.

Edit Discussion
Custom Search
Thank you for your support!
This page has been accessed 3,575 times.  This page was last modified 02:15, 13 August 2011 by Jack Leach.   Disclaimers