Sub SaveAsTextFile()
Dim strDocName As String
Dim intPos As Integer
'Find position of extension in filename
strDocName = ActiveDocument.Name
intPos = InStrRev(strDocName, ".")
If intPos = 0 Then
'If the document has not yet been saved
'Ask the user to provide a filename
strDocName = InputBox("Please enter the name " & _
"of your document.")
Else
'Strip off extension and add ".txt" extension
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".txt"
End If
'Save file with new extension
ActiveDocument.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatText
End Sub