Sub IseciTekst()
'
' IseciTekst Macro
'
'
Dim fs
Dim wordLog
Set fs = CreateObject("Scripting.FileSystemObject")
Set wordLog = fs.CreateTextFile("c:\testfile.txt", True, True)
Dim rngstory As Word.Range
Set rngstory = ActiveDocument.Range
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = False
.MatchWholeWord = False
.Wrap = wdFindStop
.Highlight = True
While .Execute
If rngstory.HighlightColorIndex = wdGreen Then
wordLog.WriteLine rngstory
End If
Wend
End With
wordLog.Close

Set objShell = CreateObject("WScript.Shell")
Result = objShell.Run("c:\TxtReForm.exe" & " " & emailInput, 0, True)
Set objShell = Nothing

Set wrd = GetObject(, "Word.Application")
wrd.Visible = True
wrd.Documents.Open "c:\testfile2.txt"
Set wrd = Nothing
End Sub