Word VBA: Export TRADOS Segments to Text File

Sub ExportSeg()
	'ExportSeg Macro - Created 2007/09/04 by Michael Grant
    'Created for ancient versions of TRADOS that ran as an MS Word plugin.
    'Could easily be extended to export as csv or xml/tmx.

    Selection.HomeKey unit:=wdStory  'Make sure we're at the beginning of the document
    
    Selection.Find.ClearFormatting  'Reset search parameters

    Open "C:\segments.txt" For Output As #1

    With Selection.Find
        .Text = "[{0>](*)[<}][0-9]{1,3}[{>](*)[<0}]{3}"  'Select the whole tag and start the "show"!
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True

        Do While .Execute
            If Left$(Selection.Text, 3) = "{0>" Then  'Finds first matching translation unit

                step0 = Selection.Text
                step1 = Mid$(Selection.Text, 4)        'Trim off the opening TRADOS tag
                step2 = Left$(step1, (Len(step1) - 3)) 'Trim off the closing TRADOS tag
                                                       'step2 now equals: source_text<}0{>target_text
                step3 = InStr(step2, "<}")             'Find start pos of middle TRADOS tag
                step4 = InStr(step2, "{>")             'Find end pos of middle TRADOS tag

                strJPN = Left$(step2, (step3 - 1))                 'Save source text in a variable
                strENG = right$(step2, Len(step2) - (step4 + 1))   'Save target text in a variable
                If InStr(strJPN, ",") <> 0 Then
                    thisJPN = Chr(34) & strJPN & Chr(34)
                Else
                    thisJPN = strJPN
                End If
                If InStr(strENG, ",") <> 0 Then
                    thisENG = Chr(34) & strENG & Chr(34)
                Else
                    thisENG = strENG
                End If


                Print #1, thisENG & Chr(44) & thisJPN & Chr(44) & Selection.Information(wdActiveEndPageNumber)
            End If
        Loop
    End With

    Selection.Find.Execute

    Close #1
    Selection.Find.ClearFormatting  'Reset search parameters
    ' Display a message indicating the search has been completed.

    MsgBox (" DONE ")

End Sub