Convert all .docx files in a folder to .txt files that can be loaded in ApSIC Xbench

convert2tabtxt.bas

Sub Convert2TabTxt()
    Dim strPath As String
    Dim strFile As String
    Dim doc As Document
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder specified!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    On Error GoTo ErrHandler
    strFile = Dir(strPath & "*.docx")
    Do While strFile <> ""
        Set doc = Documents.Open(strPath & strFile)
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "^t"
            .Replacement.Text = "->"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchWildcards = False
            .Execute Replace:=wdReplaceAll
        End With
        
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "(*)^013"
            .Replacement.Text = "\1^t\1^p"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
        doc.SaveAs2 FileName:=strPath & Replace(Expression:=strFile, _
            Find:=".docx", Replace:=".txt", Compare:=vbTextCompare), _
            FileFormat:=wdFormatEncodedText, Encoding:=65001 ' msoEncodingUTF8
        doc.Close SaveChanges:=False
        strFile = Dir
    Loop
    MsgBox "All files in folder processed!", vbInfo
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub