'-----------------------------------------------------------------------------------------------------------------------
' 14.12.2010
' Конвертор rtf в txt с выборочным преобразованием текста
' Перебирает файлы папки sInFolderName, в подпапках не ищет. Все найденные файлы с расширением rtf пытается открыть и 
' при успехе преобразует в txt с кодировкой CP866 (DOS), сохраняя их с теми же именами в папку sOutFolderName 
' (имеющиеся файлы молча перезаписывает)
' 
' Папки sInFolderName и sOutFolderName находятся в одной папке с запускаемым скриптом
' 
' Дополнительные преобразования текста: 
'   убирает пустые строки
'   заменяет вхождения строк массива aPatterns на строки массива aReplaces
'-----------------------------------------------------------------------------------------------------------------------
option explicit

dim sInFolderName  : sInFolderName  = "In"  'Имя папки входящих (rtf)
dim sOutFolderName : sOutFolderName = "Out" 'Имя папки с результатами (txt)

'sCurFolder => диск:\путь_запуска_данного_скрипта\
dim sCurFolder : sCurFolder = Mid(WScript.ScriptFullName, 1, Len(WScript.ScriptFullName) - Len(WScript.ScriptName)) 
dim oFS : set oFS = WScript.CreateObject("Scripting.FileSystemObject")
dim sInFolderPath, sOutFolderPath
sInFolderPath = sCurFolder & sInFolderName
sOutFolderPath = sCurFolder & sOutFolderName

const wdFormatText = 2
dim i
dim aPatterns : aPatterns = Array("(RD1\|[^\|]+\|[^\|]+\|)", "(RD2\|[^\|]+\|[^\|]+\|)", "(RD3\|[^\|]+\|[^\|]+\|)")
dim aReplaces : aReplaces = Array("$120|", "$130|", "$131|")
if UBound(aPatterns) <> UBound(aReplaces) then 'антиглупин
  WScript.Echo "Число масок поиска aPatterns не соответствует числу замен aReplaces - надо исправить!" & _
    " (ничего не сделано)"
end if

if oFS.FolderExists(sInFolderPath) and oFS.FolderExists(sOutFolderPath) then
  dim oInFolder : set oInFolder = oFS.GetFolder(sInFolderPath)
  dim oFile
  dim oW : set oW = WScript.CreateObject("Word.Application")
  for each oFile in oInFolder.Files
    dim re : set re = CreateObject("VBScript.RegExp")
    re.Pattern = "\.rtf$"
    re.IgnoreCase = true
    if re.Test(oFile.Path) then 'файл оканчивается на ".rtf"
      dim sText
      dim sFileOut : sFileOut = sOutFolderPath & "\" & re.Replace(oFile.Name, ".txt") 'Результат
      
      on error resume next
      with oW.Documents.Open(oFile.Path)
        ' oW.Visible = true 'если хотим полюбоваться мельканием окошек
        oW.Selection.WholeStory
        sText = oW.Selection.Text
        
        'избавляемся от пустых строк
        re.Pattern = "(^\s*$)+(^.)"
        re.Global = true
        re.Multiline = true
        sText = re.Replace(sText, "")
        'RD-замены
        for i = 0 to UBound(aPatterns)
          re.Pattern = aPatterns(i)
          sText = re.Replace(sText, aReplaces(i))
        next
        
        oW.Selection = sText 'вставляем измененный текст взамен прежнего
        with oW.Selection.ParagraphFormat 'убираем отступы форматирования, чтобы они не стали в txt пробелами
          .LeftIndent = 0
          .RightIndent = 0
          .SpaceBefore = 0
          .FirstLineIndent = 0
        end with
        .SaveAs sFileOut, wdFormatText, , , , , , , , , , 866
        .Close
      end with
      if Err then
        WScript.Echo "Ошибка при работе с '" & oFile.Name & "'  " & Err.Number & " " & Err.Description
      end if
      on error goto 0
    end if 'файл оканчивается на ".rtf"
  next
  oW.Quit
  set oW = Nothing
else
  WScript.Echo "Не нашлось входной ('" & sInFolderPath & "') или выходной ('" & sOutFolderPath & _
    "') папок.  (ничего не сделано)"
end if 'есть все нужные папки

'Синтаксис на память:
' Sub SaveAs([FileName], [FileFormat], [LockComments], [Password], [AddToRecentFiles], [WritePassword], [ReadOnlyRecommended], [EmbedTrueTypeFonts], [SaveNativePictureFormat], [SaveFormsData], [SaveAsAOCELetter], [Encoding], [InsertLineBreaks], [AllowSubstitutions], [LineEnding], [AddBiDiMarks])

задаем файл (c:\test.txt он содержит например 20 каких то строк)
for each строка in файл
"какое то действие с этой строкой" (ну например вывод содержимого строки в сообщении)
next

Selection.WholeStory //выделить все
Selection.Text //обратиться к выделенному тексту

dim re, str
set re = CreateObject("VBScript.RegExp")
re.Pattern = "(RD1\|[^\|]+\|[^\|]+\|)"
str = "RD1|010|18210102010013000110|108.00|0.00|0.00|108.00|"
WScript.Echo re.replace(str, "$1ля-ля|")

const wdFormatText = 2
dim sCurFolder : sCurFolder = Mid(WScript.ScriptFullName, 1, Len(WScript.ScriptFullName) - Len(WScript.ScriptName))
dim sFileIn : sFileIn = sCurFolder & "1.rtf" 'Подопытный
dim sFileOut : sFileOut = sCurFolder & "1.txt" 'Результат
dim oFS : set oFS = WScript.CreateObject("Scripting.FileSystemObject")
dim oW : set oW = WScript.CreateObject("Word.Application")
With oW.Documents.Open(sFileIn)
  .SaveAs sFileOut, wdFormatText, , , , , , , , , , 866
' Sub SaveAs([FileName], [FileFormat], [LockComments], [Password], [AddToRecentFiles], [WritePassword], [ReadOnlyRecommended], [EmbedTrueTypeFonts], [SaveNativePictureFormat], [SaveFormsData], [SaveAsAOCELetter], [Encoding], [InsertLineBreaks], [AllowSubstitutions], [LineEnding], [AddBiDiMarks])
  .Close
End With
oW.Quit

echo off
setlocal ENABLEDELAYEDEXPANSION
set filertf=file.txt
set "pattern=|6|"
for /f "delims=" %%i in (%filertf%) do (
    set out=%%i
    set "out=!out:%pattern%=|55|6|!"
    echo !out!
    )