Чтение данных из текстового файла vba

Question

У меня есть несколько подпапок. В каждом есть текстовые файлы. Можно группировать текстовые файлы в одном файле excel таким образом, что на вкладке excel будет один файл. Я разработал код для выполнения этой задачи.

Option Explicit 
Sub read_files() 
Dim ReadData As String 
Dim i As Double 
Dim objfso As Object 
Dim objfolder As Object 
Dim obj_sub_folder As Object 
Dim objfile As Object 
Dim current_worksheet As Worksheet 
Dim new_workbook As Workbook 
Dim path As String 
Dim filestream As Integer 


Set objfso = CreateObject("Scripting.FilesystemObject") 
Set objfolder = objfso.getfolder("Z:\test\") 
Set new_workbook = Workbooks.Add 
i = 1 

For Each obj_sub_folder In objfolder.subfolders 
    i = 1 
    ReadData = "" 
    For Each objfile In obj_sub_folder.Files 
     Set current_worksheet = new_workbook.Worksheets.Add 
     current_worksheet.Name = objfile.Name 
     filestream = FreeFile() 
     path = "Z:\test\" & obj_sub_folder.Name & "\" & objfile.Name 
     Open path For Input As #filestream 
     Do Until EOF(filestream) 
      Input #filestream, ReadData 
      current_worksheet.Cells(i, 1).Value = ReadData 
      i = i + 1 
     Loop 
     Close filestream 
    Next 
    ActiveWorkbook.SaveAs "Z:\test\" & obj_sub_folder.Name 
Next End Sub 

Однако, в то время как цикл через вложенные папки, макросы сохраняют данные из файлов в предыдущих подпапках, но я хочу, чтобы сохранить данные из файлов, которые приходят от конкретной подпапки. Не могли бы вы объяснить мне, где моя ошибка?

Спасибо!

EDIT

здесь работает код

Option Explicit 
Sub run() 
    read_files ("Z:\test\") 
End Sub 
Sub read_files(path_to_folder As String) 
Dim ReadData As String 
Dim i As Double 
Dim objfso As Object 
Dim objfolder As Object 
Dim obj_sub_folder As Object 
Dim objfile As Object 
Dim current_worksheet As Worksheet 
Dim new_workbook As Workbook 
Dim path As String 
Dim filestream As Integer 

Set objfso = CreateObject("Scripting.FilesystemObject") 
Set objfolder = objfso.getfolder(path_to_folder) 
i = 1 

For Each obj_sub_folder In objfolder.subfolders 
    Set new_workbook = Workbooks.Add 

    For Each objfile In obj_sub_folder.Files 
     Set current_worksheet = new_workbook.Worksheets.Add 
     current_worksheet.Name = objfile.Name 
     filestream = FreeFile() 
     path = path_to_folder & obj_sub_folder.Name & "\" & objfile.Name 
     Open path For Input As #filestream 
     Do Until EOF(filestream) 
      Input #filestream, ReadData 
      current_worksheet.Cells(i, 1).Value = ReadData 
      i = i + 1 
     Loop 
     Close filestream 
     i = 1 
    Next 
    ActiveWorkbook.SaveAs path & obj_sub_folder.Name 
    ActiveWorkbook.Close 
Next 

End Sub

Answer 1

Если вы хотите, чтобы данные каждой вложенной папки, чтобы быть в отдельной книге, то вам необходимо переместить new_workbook определение внутри вашей For Each obj_sub_folder а также закрыть эту книгу после сохранения:

Set objfso = CreateObject("Scripting.FilesystemObject") 
Set objfolder = objfso.getfolder("Z:\test\") 
i = 1 

For Each obj_sub_folder In objfolder.subfolders 
    Set new_workbook = Workbooks.Add 
    i = 1 
    ReadData = "" 
    For Each objfile In obj_sub_folder.Files 
     Set current_worksheet = new_workbook.Worksheets.Add 
     current_worksheet.Name = objfile.Name 
     filestream = FreeFile() 
     path = "Z:\test\" & obj_sub_folder.Name & "\" & objfile.Name 
     Open path For Input As #filestream 
     Do Until EOF(filestream) 
      Input #filestream, ReadData 
      current_worksheet.Cells(i, 1).Value = ReadData 
      i = i + 1 
     Loop 
     Close filestream 
    Next 
    new_workbook.SaveAs "Z:\test\" & obj_sub_folder.Name 
    new_workbook.Close 
Next