Как объединить несколько текстовых файлов в один?

'---------------------------------------------------------------------------------------
' Author : Щербаков Дмитрий(The_Prist)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
' Purpose: Процедура сбора данных с указанных текстовых файлов, оставляя только один заголовок
'---------------------------------------------------------------------------------------
Option Explicit
 
Sub Get_All_TXT_SkipHeader()
    Dim avFiles, li As Long, lHeadLinesCount As Long, lh As Long
    Dim objFSO As Object, objTxtFile As Object, sTxt, sAllTxt
    Dim IsSkipHeader As Boolean
    'диалог выбора текстовых файлов. Подробнее:
    '   https://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/
    avFiles = Application.GetOpenFilename("TXT files(*.txt),*.txt,CSV files(*.csv),*.csv", , , , True)
    If VarType(avFiles) = vbBoolean Then Exit Sub
 
    IsSkipHeader = MsgBox("Оставлять только один заголовок(первого файла)?", vbQuestion + vbYesNo, "www.excel-vba.ru") = vbYes
    If IsSkipHeader Then
        lHeadLinesCount = Val(InputBox("Сколько строк в заголовке?", "www.excel-vba.ru", 1))
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For li = LBound(avFiles) To UBound(avFiles)
        'открываем текстовый файл
        Set objTxtFile = objFSO.OpenTextFile(avFiles(li), 1)
        'если заголовок уже записан и указано оставлять только один заголовок
        'пропускаем строки заголовков для 2-го и последующих файлов
        If IsSkipHeader Then
            If li > LBound(avFiles) Then
                For lh = 1 To lHeadLinesCount
                    objTxtFile.skipline
                Next
            End If
        End If
        'считываем все данные файла
        sTxt = objTxtFile.ReadAll
        If sAllTxt = "" Then
            sAllTxt = sTxt
        Else
            sAllTxt = sAllTxt & sTxt
        End If
        'закрываем текстовый файл
        objTxtFile.Close
    Next li
    'создаем новый файл и записываем в него все считанные с файлов данные
    Set objTxtFile = objFSO.CreateTextFile("C:\AllText.txt", True)
    objTxtFile.WriteLine sAllTxt
    objTxtFile.Close
    Set objTxtFile = Nothing
    Set objFSO = Nothing
End Sub

'--------------------------------------------------------------------------------------- ' Author : Щербаков Дмитрий(The_Prist) ' Профессиональная разработка приложений для MS Office любой сложности ' Проведение тренингов по MS Excel ' https://www.excel-vba.ru ' info@excel-vba.ru ' Purpose: Процедура сбора данных с указанных текстовых файлов, оставляя только один заголовок '--------------------------------------------------------------------------------------- Option Explicit Sub Get_All_TXT_SkipHeader() Dim avFiles, li As Long, lHeadLinesCount As Long, lh As Long Dim objFSO As Object, objTxtFile As Object, sTxt, sAllTxt Dim IsSkipHeader As Boolean 'диалог выбора текстовых файлов. Подробнее: ' https://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/ avFiles = Application.GetOpenFilename("TXT files(*.txt),*.txt,CSV files(*.csv),*.csv", , , , True) If VarType(avFiles) = vbBoolean Then Exit Sub IsSkipHeader = MsgBox("Оставлять только один заголовок(первого файла)?", vbQuestion + vbYesNo, "www.excel-vba.ru") = vbYes If IsSkipHeader Then lHeadLinesCount = Val(InputBox("Сколько строк в заголовке?", "www.excel-vba.ru", 1)) End If Set objFSO = CreateObject("Scripting.FileSystemObject") For li = LBound(avFiles) To UBound(avFiles) 'открываем текстовый файл Set objTxtFile = objFSO.OpenTextFile(avFiles(li), 1) 'если заголовок уже записан и указано оставлять только один заголовок 'пропускаем строки заголовков для 2-го и последующих файлов If IsSkipHeader Then If li > LBound(avFiles) Then For lh = 1 To lHeadLinesCount objTxtFile.skipline Next End If End If 'считываем все данные файла sTxt = objTxtFile.ReadAll If sAllTxt = "" Then sAllTxt = sTxt Else sAllTxt = sAllTxt & sTxt End If 'закрываем текстовый файл objTxtFile.Close Next li 'создаем новый файл и записываем в него все считанные с файлов данные Set objTxtFile = objFSO.CreateTextFile("C:\AllText.txt", True) objTxtFile.WriteLine sAllTxt objTxtFile.Close Set objTxtFile = Nothing Set objFSO = Nothing End Sub