Как программно объединить все текстовые файлы в один?

1. Вариант

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

   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

   Удалённые файлы в корзину не помещаются, так что будьте внимательны и используйте этот макрос только, если Вы уверены в необходимости удаления файлов.

2. Вариант
   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
   [syntax=#vba]