RTF to DOC conversion

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

'''' Script program to convert RTF to DOC.
' Paste code in a notepad. Save as anyname.vbs
' Close notepad
' double click to run. Will require WSH 5.6 for win2K or win98
' Win XP is already WSH 5.6

'
''# Coded by Emilio de Leon 2 Jan 2006 in VBscript.Double click to run.
'# put this script into any folder requiring RTF conversion to DOC
'###########################################################

'' Start of Script
Option Explicit
On Error Resume Next
Dim Response
Dim anRTForDOCisOpen_Flag
dim nominatedFolder
dim fso
dim oApp
set oApp = createobject("Word.Application")
Set fso = CreateObject("Scripting.FileSystemObject")

nominatedFolder =fso.GetAbsolutePathName ("convertRTF2DOC.vbs")

nominatedFolder = Left(nominatedFolder, _
Len(nominatedFolder)-19)
Response = MsgBox("Instruction:" & vbCrLf & _
"Place a copy of this program in any folder that" & _
" contains .rtf files that you want to convert to .doc files." _
& vbCrLf & _
"Please CLOSE all .rtf files to be converted to .doc files." _
& " And CLOSE all related .doc file with similar name as the .rtf. " _
& vbCrLf & "Double click on the program to start it and get this" & _
"initial window message prompt." & vbCrLf & vbCrLf & _
"Note:"&vbCrLf & _
"This program will completely replace the RTF files with DOC files." _
& vbCrLf & vbCrLf & "This program's current folder is " _
& nominatedFolder _
& vbCrLf & vbCrLf & vbCrLf & _
"Press OK button to continue with the conversion.", vbOKCancel, _
"RTF to DOC")

If Response <> 2 Then

ShowFolderList(nominatedFolder) ' call procedure

End if
oApp.Quit
set oApp = nothing
Set fso = nothing
Set nominatedFolder = nothing
' End of Script

'**************sub procedure*******************
'this sub procedure is copied from Peter Jamieson post
'Thanks for inspiring me to expand your original script
sub convertRTFtoDOC(pathWithRTFfilename)
dim newpathFilename 'as string
dim oDoc 'as object

newpathFilename = pathWithRTFfilename
' the ,0 parameter means do not confirm conversions
set oDoc = oApp.Documents.Open(newpathFilename,0)
'remove .rtf and replace with .doc as the new filename
newpathFilename = Left(newpathFilename, _
Len(newpathFilename) - 4) & ".doc"
' the 0 parameter means use .doc format
oDoc.SaveAs newpathFilename, 0
oDoc.close ' Important to close the .doc file

End sub

'************sub procedure********************
Sub ShowFolderList(folderspec)
Dim fs, f, f1, fc, s, i
i = 0
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
'loop & capture RTF & send to another sub for conversion to DOC
For Each f1 in fc

verifyIfRTForDOCopen (f1.name)
if (anRTForDOCisOpen_Flag = true) then
exit sub
end if

if (f1.type = "Rich Text Format") then

convertRTFtoDOC f1

s = s & f1.name
s = s & vbCrLf 'visualbasicCarriageLineFeed
f1.Delete True ' True force delete of read only file
i = i + 1 'count how many .rtf files

end if
Next

' release memory use by object - not needed anymore.
Set fs = nothing
Set f = nothing
Set fc = nothing

If s = "" then
MsgBox "No .rtf file have been found in the folder " & folderspec & _
vbCrLf & vbCrLf & "Press OK button to EXIT."
else
MsgBox s & vbCrLf & i & " .rtf file converted to .doc file."
end if
Set nominatedFolder = nothing
End Sub

'*********************sub procedure***********************
sub verifyIfRTForDOCopen (f1dotname)

Dim colTasks , objTask, strName1,strName2
Set colTasks = oApp.Tasks
anRTForDOCisOpen_Flag = false

For Each objTask in colTasks

strName1 = Lcase(objTask.Name)
strName2 = Lcase(Left(f1dotname,Len(f1dotname) - 4))

If (Instr(strName1,strName2) >= 1) Then
MsgBox f1dotname & " is left open. Please close this file. " _
& vbCrLf & vbCrLf & _
"This program is halted!!! " & _
"Close all RTF and related DOC file before restarting program."_
, 0,"You have forgotten to close a file!!!"

anRTForDOCisOpen_Flag = true

exit sub
End If
Next
End sub

.

Relevant Pages

  • Re: Detecting is hyperthreading is enabled with WMI?
    ... It is too bad that WMI does not give this info. ... have to be done to the script. ... Public Sub DisplayProcessorInfo ... dim ProcessorSet, Processor ...
    (microsoft.public.windowsxp.wmi)
  • Re: Collecting output generated via one spreadsheet into a new spreasheet
    ... A quick read of the script indicates that it makes no attempt to actually write out any of the information is has found. ... 'Call Output sub ... I would hazard a guess that if the output contains only the info associated with the last record from the input file, that you are failing to increment the row counter associated with the output spreadsheet after writing to it. ... Dim strUserName, objUserDomain, objGroup, objUser, strGroupList ...
    (microsoft.public.scripting.vbscript)
  • Re: Displaying text output in one external window
    ... application I use to control a script ... the log file and displays it in a ... > Dim oShell ... > Sub SaveScript() ...
    (microsoft.public.scripting.wsh)
  • Collecting output generated via one spreadsheet into a new spreasheet
    ... an excellent script written by Ralph Montgomery named NTUser.wsf for account ... Dim strUserName, objUserDomain, objGroup, objUser, strGroupList ... Dim objPwdExpiresTrue, objFlags, oPwdExpire, strPwdExpires ... Sub GetInfo() ...
    (microsoft.public.scripting.vbscript)
  • Re: Emulating VB6 code window
    ... my code for setting/removing highlights is very similar to ... > appear manipulate the full RTF Rick. ... >> End Sub ... >> Dim CStart As Long ...
    (microsoft.public.vb.controls)