Importing Multiple Text Files Into One Sheet. Text Files are in different subfolders but are the same name

[docherro]

I am trying to write a vba code that automatically pulls text files with the same name into one sheet, pasting across columns. The files are in a subfolder of an other subfolder. Each file is in a separate folder. My code can find the folder and locate the file, however I can't find a function that pastes the text files by column (each file only has 2 columns) and in the same spreadsheet. It keeps starting a new workbook because I use Workbooks.Open and after the 1st workbook opens, I get an error stating that two workbooks with the same name can't be open at the same time (because the text files are the same name).

I just want to stop opening a new workbook for each file, but I want to paste all text files with this name ("xy_mean.txt") into the same spreadsheet in consecutive columns. Below is the code.

There are 8 subfolders in "Text Files to Import" folder that each contain a desired text file

Sub LoopSubfoldersAndFiles()
Dim fso As Object
Dim folder As Object
Dim subfolders As Object
Dim MyFile As String
Dim wb As Workbook
Dim CurrFile As Object


With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Set fso = CreateObject("Scripting.<wbr>FileSystemObject")
Set folder = fso.GetFolder("S:\1\2\3\Text Files Import")
Set subfolders = folder.subfolders
MyFile = "xy_mean.txt"

For Each subfolders In subfolders

Set CurrFile = subfolders.Files

For Each CurrFile In CurrFile
If CurrFile.Name = MyFile Then
Set wb = Workbooks.Open(subfolders.Path & "" & MyFile)
Selection.TextToColumns _
Destination:=Range("A2:F900")

End If
Next

Next

Set fso = Nothing
Set folder = Nothing
Set subfolders = Nothing


With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With


End Sub

 

[Rijnsent]

Hi Docherro,

what you probably want to do is import all your data into a master excel file, so: open, copy, close the text files. The code below is untested, but you hopefully get the idea and can debug it from here?

Cheers,

Koen

Sub LoopSubfoldersAndFiles()
Dim fso As Object
Dim folder As Object
Dim subfolders As Object
Dim MyFile As String
Dim wb As Workbook
Dim CurrFile As Object


With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set ActWb = ActiveWorkbook
Set Sht = ActWb.Worksheets("RESULTS")
ResCol = 1

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("S:\1\2\3\Text Files Import")
Set subfolders = folder.subfolders
MyFile = "xy_mean.txt"

For Each subfolders In subfolders

    Set CurrFile = subfolders.Files
    For Each CurrFile In CurrFile
        If CurrFile.Name = MyFile Then
            'Open file, copy data, close file
            Set wb = Workbooks.Open(subfolders.Path & "" & MyFile)
            Selection.TextToColumns _
            Destination:=Range("A2:F900")
            Set ShtFrom = wb.ActiveSheet
            ShtFrom.Range("A2:F900").Copy Destination:=Sht.Range("A2:F900").Offset(0, ResCol)
            ResCol = ResCol + 6
            wb.Close SaveChanges:=False
        End If
    Next

Next

Set fso = Nothing
Set folder = Nothing
Set subfolders = Nothing


With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With


End Sub