Программно объединить все текстовые файлы в один- Visual Basic(Бейсик)

Вариант
Если Вам необходимо создать текстовый файл, содержащий данные всех текстовых файлов, находящихся в определённой папке, то используйте нижеопубликованный макрос, естественно, не забыв указать(выбрать) исходную папку, а также имя итогового(результирующего) файла.

code: #vba
Private Sub ConcatenateTextFiles()
    Dim iPath$, iFileName$, iText$
 
    iPath = "C:\Мониторинг\2005\04\"
    iFileName = Dir(iPath & "*.txt")
 
    If iFileName <> "" Then
       Do
            Open iPath & iFileName For Input As #1
                 iText = iText & vbNewLine & Input(LOF(1), #1)
            Close #1
            iFileName = Dir()
       Loop Until iFileName = ""
 
       Open iPath & "Result.txt" For Output As #1
            Print #1, iText 'Write #1, iText
       Close #1
    End If
End Sub
Если текстовый файл, содержащий объединённые данные, будет находиться в той же папке, что и исходные файлы, то при повтором запуске макроса, его данные также будут участвовать в объединении. Чтобы этого избежать, достаточно просто создавать итоговый файл в другой папке.

Если же, при объединении текстовых файлов, Вам желательно "разграничить" их данные, создав небольшую шапку, содержащую также имя файла, а после объединения, исходные файлы необходимо ещё и удалить, то используйте следующую версию:

code: #vba
Private Sub ConcatenateTextFiles4()
    Dim iPath$, iFileName$, iResult$, iText$, iHeader$
 
    iPath = "C:\Мои документы\Отчёты\5\"
    iResult = "Result_" & Date$ & ".txt"
 
    iHeader = vbCrLf & String(75, "*")
    iHeader = iHeader & vbCrLf & "FileName"
    iHeader = iHeader & vbCrLf & String(75, "*")
    iHeader = iHeader & vbCrLf
 
    iFileName = Dir(iPath & "*.txt")
    If iFileName <> "" Then
       Do
            Open iPath & iFileName For Input As #1
                 iText = iText & Application.Substitute( _
                 iHeader, "FileName", iFileName) & Input(LOF(1), #1)
            Close #1
            iFileName = Dir()
       Loop While iFileName <> ""
       Kill PathName:=iPath & "*.txt"
 
       Open iPath & iResult For Output As #1
            Print #1, iText '
       Close #1
    End If
End Sub
Удалённые файлы в корзину не помещаются, так что будьте внимательны и используйте этот макрос только, если Вы уверены в необходимости удаления файлов.

Вариант
code: #vba
Private Sub MSDOS_ConcatenateTextFiles()
    Shell "Cmd.exe /C Copy C:\Имя_папки\*.txt C:\Result.txt", vbHide
    'Shell "Cmd.exe /C Copy ""C:\Имя Папки с пробелом\*.txt"" C:\Result.txt", vbHide