VBA script to extract text from directory of Word documents into one plaintext file

jukhamil 

See if this does what you want:

Sub CombineDocs()
    Dim sFolder As String
    Dim sFile As String
    Dim sDesktop As String
    Dim dSource As Document
    Dim dTarget As Document
    Dim rng As Range
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        If .Show Then
            sFolder = .SelectedItems(1)
            If Right(sFolder, 1) <> "\" Then
                sFolder = sFolder & "\"
            End If
        Else
            Beep
            Exit Sub
        End If
    End With
    Application.ScreenUpdating = False
    Set dTarget = Documents.Add
    If Right(sFolder, 1) <> "\" Then
        sFolder = sFolder & "\"
    End If
    sFile = Dir(sFolder & "*.doc*")
    Do While sFile <> ""
        Set dSource = Documents.Open(FileName:=sFolder & sFile, ReadOnly:=True, AddToRecentFiles:=False)
        dSource.Content.Copy
        Set rng = dTarget.Content
        rng.Collapse Direction:=wdCollapseEnd
        rng.Paste
        dSource.Close SaveChanges:=False
        sFile = Dir
    Loop
    sDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    dTarget.SaveAs2 FileName:=sDesktop & "\Text.txt", FileFormat:=wdFormatUnicodeText
    dTarget.Close SaveChanges:=False
End Sub