Reading data from text file vba

Question

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

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. — Alan Waage, Sep 09 '13 at 20:26
@AlanWaage, but if I do like you have suggested, then I have to create import file. — mr.M, Sep 10 '13 at 04: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. — Alan Waage, Sep 10 '13 at 12:48
see [**`this walkthrough`**](http://vba4all.wordpress.com/category/vba-macros/reading-txt-files-from-vba/) for how to read txt files in vba — , Sep 12 '13 at 11:44

score 2 · Accepted Answer · answered Sep 09 '13 at 20:36

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

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, Sep 12 '13 at 07:23
@mr.M See [here](http://stackoverflow.com/questions/11267459/vba-importing-text-file-into-excel-sheet) for various methods of importing text files -- the main thing to avoid is having to perform an action for each line. — mr.Reband, Sep 12 '13 at 13:50

Reading data from text file vba

1 Answers1