Sub MoveTextFiles()
'
' formatS Macro
' Macro created 02/28/2005 by Randall

Dim wrdApp As Word.Application, wbXL As Excel.Workbook
Dim wrdDoc As Word.Document
Dim tString As String, tRange As Word.Range
Dim p As Long, r As Long
Set wrdApp = CreateObject("Word.Application")

Application.WindowState = xlMinimized
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.WindowState = wdWindowStateMinimize
  Set sht1 = ThisWorkbook.Sheets("Sheet1")

Set fso = CreateObject("Scripting.FileSystemObject")

    
    'Set the array for the number of strum counter
    'The limit is set to 200  STRUMs
    'The number may be raised if you happend to have more than 200 STRUM
    Dim TextFiles(1000) As Variant
    Dim cl As Range
    'finds current document name
    MainDocPath = Application.ActiveWorkbook.Path
    
        
    'Searches for all text files in folder
    With Application.FileSearch
        .NewSearch
        .LookIn = MainDocPath
        .SearchSubFolders = True
        .Filename = "*.txt"
        .MatchAllWordForms = False
        .Execute
            
        For i = 1 To .FoundFiles.Count
            'Workbooks.Open Filename:=.FoundFiles(i)
            'FFName = ActiveWorkbook.Name
    '*************locks up here*****************

            'wrdApp.Visible = True
            Set wrdDoc = wrdApp.Documents.Open(.FoundFiles(i))
            With sht1
                For Each cl In .Range("A2", .Range("A65536").End(xlUp))
                    
            
                    With wrdDoc
                        Selection.Find.ClearFormatting
                        Selection.Find.Replacement.ClearFormatting
                        With Selection.Find
                            .Text = cl.Value
                            .Replacement.Text = cl.Offset(0, 1)
                            .Forward = True
                            .Wrap = wdFindContinue
                            .Format = False
                            .MatchCase = False
                            .MatchWholeWord = False
                            .MatchWildcards = False
                            .MatchSoundsLike = False
                            .MatchAllWordForms = False
                        End With
                        Selection.Find.Execute Replace:=wdReplaceAll
                    End With
                Next cl
               With wrdDoc
                    ChangeFileOpenDirectory MainDocPath
                    ActiveDocument.SaveAs Filename:=ActiveWorkbook.Name, FileFormat:=wdFormatText, _
                        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
                        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
                        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
                        False, Encoding:=1252, InsertLineBreaks:=False, AllowSubstitutions:=False _
                        , LineEnding:=wdLFOnly
                    .Close ' close the document
                 End With
                
            End With

        Next i
    End With
    
Application.ScreenUpdating = True
Application.WindowState = xlMaximized
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
ActiveWorkbook.Close
Application.DisplayAlerts = wdAlertsAll

End Sub

                    With ActiveSheet.Range("A1", ActiveSheet.Range("B65536").End(xlUp))
                        .Replace What:=cl.Value, Replacement:=cl.Offset(0, 1).Value, _
                        SearchOrder:=xlByColumns, MatchCase:=True
                    End With