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

disel
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Вариант
Если Вам необходимо создать текстовый файл, содержащий данные всех текстовых файлов, находящихся в определённой папке, то используйте нижеопубликованный макрос, естественно, не забыв указать(выбрать) исходную папку, а также имя итогового(результирующего) файла.
 
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

Похожие записи/страницы:

Leave a Comment