Binaryworld - ConvertWordDocument - Convert a Microsoft Word DOC file to another for ... [ VB -> Exteral Libs ]

' Convert a Word-compatible format to an other format.
' Parameters:
' - sFileName is the file to convert
' - wdFormat is the destination file's format
' - sNewFileName is the destination file. If not specified the the routine
' will use the sFileName's path & name
'
' NOTE: requires the Microsoft Word type library
'
' Example: convert from DOC to HTML
' ConvertWordDocument("C:\Documents\MyWordFile.doc", wdFormatHTML)

Function ConvertWordDocument(ByVal sFilename As String, _
  Optional ByVal wdFormat As WdSaveFormat = wdFormatText, _
  Optional ByVal sNewFileName As String) As Boolean
  Dim iPointer As MousePointerConstants
  Dim sExtension As String
  Dim oWord As New Word.Application

  On Error GoTo ErrHandler
  iPointer = Screen.MousePointer

  ' open the file
  oWord.Documents.Open sFilename, False, False, False, , , , , , _
    wdOpenFormatAuto

  ' the destination filename if sFileName is sNewFileName is missing
  If Len(sNewFileName) = 0 Then
    sNewFileName = sFilename
    ' remove the actual extension ad add the one specified by sExtension
    If InStr(sNewFileName, ".") > 0 Then sNewFileName = Left$(sNewFileName, _
      InStr(sNewFileName, ".") - 1)
    ' set the extension for the selected destination format
    sExtension = Switch(wdFormat = wdFormatDocument, ".doc", _
      wdFormat = wdFormatDOSText, ".txt", _
      wdFormat = wdFormatDOSTextLineBreaks, ".txt", _
      wdFormat = wdFormatEncodedText, ".txt", wdFormat = wdFormatHTML, _
      ".htm", wdFormat = wdFormatRTF, ".rtf", wdFormat = wdFormatTemplate, _
      ".doc", wdFormat = wdFormatText, ".dot", _
      wdFormat = wdFormatTextLineBreaks, ".txt", _
      wdFormat = wdFormatUnicodeText, ".txt")
    ' add the extension to the file name
    sFilename = sFilename & sExtension
  End If

  ' save the file
  oWord.ActiveDocument.SaveAs sNewFileName, wdFormat, , , False

  ' close Word
  oWord.Quit
  Set oWord = Nothing

  ConvertWordDocument = True

ErrHandler:
  ' restore the original mouse pointer
  Screen.MousePointer = iPointer
End Function