Enumerating conversion of word .doc to rtf?

[dmoonme]

Hi,

I need help with converting word .docs to .rtf's.
I can do one-to-one but I need to do many-to-many.

Here's what I have so far:

Private Sub Command1_Click()
Const FORMAT_RTF = 6
Const FORMAT_TEXT = 2
Const NO_PROMPT = 2
Const OPEN_FORMAT_AUTO = 0

Dim word_server As Object ' Word.Application
Dim in_file As String
Dim in_path As String
Dim out_file As String
Dim out_path As String
Dim pos As Integer
Dim file_format As Integer

    'Screen.MousePointer = vbHourglass
    DoEvents

    On Error GoTo OpenError
    Set word_server = CreateObject("Word.Application")
    On Error GoTo 0



    in_file = "c:\test.doc"
    'txtInputFile.Text
    pos = InStrRev(in_file, "\")
    in_path = Left$(in_file, pos)
    in_file = Mid$(in_file, pos + 1)

    out_file = "c:\test.rtf"
    'txtOutputFile.Text
    pos = InStrRev(out_file, "\")
    out_path = Left$(out_file, pos)
    out_file = Mid$(out_file, pos + 1)

    pos = InStrRev(out_file, ".")
    Select Case LCase$(Mid$(out_file, pos + 1))
        Case "txt"
            file_format = FORMAT_TEXT
        Case "rtf"
            file_format = FORMAT_RTF
        Case Else
            MsgBox "Unknown file extension"
            Exit Sub
    End Select

    ' Move to the input directory.
    word_server.ChangeFileOpenDirectory in_path

    ' Open the input file.
    word_server.Documents.Open _
        FileName:=in_file, _
        ConfirmConversions:=False, _
        ReadOnly:=False, _
        AddToRecentFiles:=False, _
        PasswordDocument:="", _
        PasswordTemplate:="", _
        Revert:=False, _
        WritePasswordDocument:="", _
        WritePasswordTemplate:="", _
        Format:=OPEN_FORMAT_AUTO

    ' Move to the output directory.
    word_server.ChangeFileOpenDirectory out_path

    ' Save the output file.
    word_server.ActiveDocument.SaveAs _
        FileName:=out_file, _
        FileFormat:=file_format, _
        LockComments:=False, _
        Password:="", _
        AddToRecentFiles:=True, _
        WritePassword:="", _
        ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, _
        SaveFormsData:=False, _
        SaveAsAOCELetter:=False

    ' Exit the server without prompting.
    word_server.ActiveDocument.Close False

    MsgBox ".Doc to RTF conversion successful."
    Exit Sub
    
OpenError:
    MsgBox "Error" & Str$(Error.Number) & _
        " opening Word." & vbCrLf & _
        Error.Description
    Screen.MousePointer = vbDefault
End Sub





[\code]

 

[fumei]

Can this do much easier. The following converts all .doc files in specified folder to RTF.

Sub MakeRTF()
Dim aDoc
Dim tempFilename As String
application.ScreenUpdating = False
aDoc = Dir("c:\test\*.doc")
Do While aDoc <> ""
    Documents.Open FileName:="c:\Test\" & aDoc
' strip off .doc from the name
    tempFilename = Left(aDoc, (Len(aDoc) - 4))
    ActiveDocument.SaveAs FileName:="c:\RTF_Files\" & tempFilename, fileformat:=wdFormatRTF
    ActiveDocument.Close wdDoNotSaveChanges
    aDoc = Dir
Loop
application.ScreenUpdating = True
End Sub

This could be adapted to handle .txt files as well. The input location (of the .doc files) and output location (of the RTF files) could be any folder you want.

Gerry

 

[dmoonme]

Gerry, THANKS! It works like a charm.

 

[fumei]

You're welcome.

Gerry