[megaloman]

VBS

Код:

FileInTxt = "Z:\Box_In\TxtBlanc.txt"
FileInBas = "Z:\Box_In\База.xlsx"

FileOut = "Z:\Box_Out\База.txt"

MRep = Array("^\[.*\] *", "B3", _
        "name=", "C3", _
        "bdate=", "D3")

LRep = LBound(MRep)
URep = UBound(MRep)

Set Book = CreateObject("Excel.Application")
Book.Visible = False 'True  ' False	'
Book.Workbooks.Open FileInBas

Set FSO = CreateObject("Scripting.FileSystemObject")

Set fIn = FSO.OpenTextFile(FileInTxt, 1, False)
InTxt = Trim(fIn.ReadAll)
fIn.Close

If Right(InTxt, 2) <> vbCrLf Then InTxt = InTxt + vbCrLf

Set F = FSO.CreateTextFile(FileOut, True)

Skip = ""
With CreateObject("VBScript.RegExp")
    .IgnoreCase = True
    j = 0
    Do
        If Trim(Book.Range(MRep(LRep + 1)).Offset(j, 0)) = "" Then Exit Do
        For i = LRep To URep Step 2
            If i = LRep Then
                .Pattern = MRep(i) + vbCrLf
                InTxt = .Replace(InTxt, "[" + CStr(Book.Range(MRep(i + 1)).Offset(j, 0)) + "]" + vbCrLf)
            Else
                .Pattern = vbCrLf + MRep(i) + ".*" + vbCrLf
                InTxt = .Replace(InTxt, vbCrLf + MRep(i) + CStr(Book.Range(MRep(i + 1)).Offset(j, 0)) + vbCrLf)
            End If
        Next
        j = j + 1
        F.Write Skip + InTxt
        Skip = vbCrLf
    Loop
End With
F.Close
'Book.ActiveWorkbook.Close
Book.Quit