0

I have several subfolders. In each there are text files. It is possible to group text files in one excel file in a such way that there will be one file per excel tab. I have designed code to do this task.

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

However, while looping through subfolders, macros saves data from the files in previous subfolders, but I want to save data from files that come from particular sub-folder. Would you be so kind to explain me where is my mistake?

Thank you!

EDIT

here is working code

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

4
  • If you open the file with an import specification, then copy/paste the data into a new worksheet, you should bypass your file creation issue. Commented Sep 9, 2013 at 20:26
  • @AlanWaage, but if I do like you have suggested, then I have to create import file. Commented Sep 10, 2013 at 4:35
  • Only in memory, if you do not save the import no files are created. All you do is force a close without save on the new Excel object after you have copied your data to where you want it. Commented Sep 10, 2013 at 12:48
  • see this walkthrough for how to read txt files in vba Commented Sep 12, 2013 at 11:44

1 Answer 1

2

If you want each subfolder's data to be in a separate workbook, then you need to move your new_workbook definition inside your For Each obj_sub_folder loop, and also close that workbook after saving:

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 
Sign up to request clarification or add additional context in comments.

2 Comments

Would you be so kind to suggest how to improve the IO performance? It takes 4 minutes to process only one file that it very slow. I have tried to create 2d arrat, but still - 4 minutes remained ...
@mr.M See here for various methods of importing text files -- the main thing to avoid is having to perform an action for each line.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.