I hesitate to recommend this as it may create as many problems as it resolves, but assuming the previous macro worked and I don't see why it would as text files don't support fonts, then the following will process all the documents that match the parameters in the selected folder. Password protected documents are ignored.
The original files are unaltered.
Code:
Sub ProcessFolder()
'Graham Mayor - https://www.gmayor.com - Last updated - 25 Aug 2019
Dim strFile As String
Dim strPath As String
Dim oDoc As Document
Dim fDialog As FileDialog
Dim strName As String
Dim oColl As Collection
Dim iCol As Integer
Const strPassword As String = "?#nonsense@$" 'do not change
Const strExt As String = "doc" 'the extension of the files to process - here word 97-2003 DOC format.
Const strFont As String = "Times New Roman" 'the font to apply (text files do not support fonts?)
Set oColl = New Collection
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.TITLE = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
Do Until Right(strPath, 1) = Chr(92)
strPath = strPath & Chr(92)
Loop
End With
strFile = Dir$(strPath & "*.*")
While strFile <> ""
If LCase(Right(strFile, Len(strFile) - InStrRev(strFile, "."))) = strExt Then
oColl.Add strPath & strFile
End If
DoEvents
strFile = Dir$()
Wend
For iCol = 1 To oColl.Count
On Error Resume Next
WordBasic.DisableAutoMacros 1
Set oDoc = Documents.Open(FileName:=oColl(iCol), _
AddToRecentFiles:=False, _
Visible:=True, _
PasswordDocument:=strPassword, _
ReadOnly:=True, _
WritePasswordDocument:=strPassword)
If oDoc Is Nothing Or Err.Number > 0 Then
Err.Clear
GoTo NextDoc:
End If
strName = Left(oDoc.FullName, InStrRev(oDoc.FullName, ".") - 1) & ".txt"
oDoc.Range.Font.Name = strFont
oDoc.SaveAs2 FileName:=strName, FileFormat:=wdFormatUnicodeText
oDoc.Close SaveChanges:=wdDoNotSaveChanges
WordBasic.DisableAutoMacros 0
NextDoc:
DoEvents
Next iCol
MsgBox "Processing complete"
lbl_Exit:
Set oDoc = Nothing
Set fDialog = Nothing
Set oColl = Nothing
Exit Sub
End Sub