Sub RTFtoDOC()
Dim FName As String
Dialogs(wdDialogFileOpen).Show
Application.ScreenUpdating = False
FName = Dir("*.rtf")
While (FName > "")
  Application.Documents.Open FileName:=FName, ReadOnly:=True, AddToRecentFiles:=False
  ActiveDocument.SaveAs FileName:=FName, FileFormat:=wdFormatDocument
  ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
  FName = Dir()
Wend
Application.ScreenUpdating = True
End Sub