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