MyTetra Share
Делитесь знаниями!
Как объединить несколько текстовых файлов в один?
16.03.2019
23:43
Текстовые метки: fso,Excel, VBA, запись, файл, чтение,text,txt
Раздел: !Закладки - VBA - Text



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

 

В общем-то проблема не такая распространенная, как сбор данных из нескольких файлов/листов в Excel, но все же. Решил вот написать, как просто и быстро можно из множества текстовых файлов собрать информацию в один новый текстовый файл. Притом это не потребует от Вас никаких усилий, кроме как нажатия кнопочки и выбора нужных файлов. Ну и скачивания файла с этой странички. Или ручной вставки кода в свою книгу. Собственно, сам код:

Sub Get_All_TXT_Text() Dim avFiles, li As Long avFiles = Application.GetOpenFilename("TXT Files(*.txt),*.txt", , , , True) If VarType(avFiles) = vbBoolean Then Exit Sub Dim objFSO As Object, objTxtFile As Object, sTxt, sAllTxt Set objFSO = CreateObject("Scripting.FileSystemObject") For li = LBound(avFiles) To UBound(avFiles) Set objTxtFile = objFSO.OpenTextFile(avFiles(li), 1) sTxt = objTxtFile.ReadAll sAllTxt = sAllTxt & vbNewLine & sTxt 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


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

Sub Get_All_TXT_Text()

    Dim avFiles, li As Long

    avFiles = Application.GetOpenFilename("TXT Files(*.txt),*.txt", , , , True)

    If VarType(avFiles) = vbBoolean Then Exit Sub

    Dim objFSO As Object, objTxtFile As Object, sTxt, sAllTxt

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    For li = LBound(avFiles) To UBound(avFiles)

        Set objTxtFile = objFSO.OpenTextFile(avFiles(li), 1)

        sTxt = objTxtFile.ReadAll

        sAllTxt = sAllTxt & vbNewLine & sTxt

        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

Вот и все. Теперь этот код необходимо вставить в стандартный модуль. И либо создать кнопку на листе для его вызова(Как создать кнопку для вызова макроса на листе?), либо вызывать нажатием сочетания клавиш Alt+F8 -Get_All_TXT_Text -Выполнить.
После работы кода на диске "С" будет создан файл "AllText.txt", в котором и будут содержаться данные всех выбранных файлов.
Скачать пример

  Tips_Macro_Get_All_TXT_Text.xls (37,5 KiB, 4 435 скачиваний)

Прикрепленные файлы:
Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования