I need to open about 2000 flat files that are delimited by | . Each file is incremented by 1 for example br0004 ... 0005 ... 0006 but then they jump to BR1000 there are gaps in the numbering. These files are all located in the same folder. The object is to open each flat file and put the data into one sheet one record after the other. Some files have one record and some files have many records. Does anyone have any suggestions?

Thank You

Sub TestData3()
    sPath = "C:\TestData\" ' Directory containing files
    sSplit = "|" ' Delimiter character
    sFileName = Dir(sPath)
    Do Until Len(sFileName) = 0
        If (sFileName <> ".") And (sFileName <> "..") Then
            iRow = GetNextRow("Sheet1")
            lFNum = FreeFile
            Open (sPath & sFileName) For Input As lFNum
            Do While Not EOF(lFNum)
                Line Input #lFNum, sInput
                vaFields = Split(sInput, sSplit)
                For i = 0 To UBound(vaFields)
                    Sheet1.Cells(iRow, i + 1).Value = vaFields(i)
                Next i
                iRow = iRow + 1
            Loop
            Close lFNum
        End If
        sFileName = Dir()
    Loop
End Sub

should do?

Hi

Alternatively try this for size!!

Sub mdl_ForEachFileInFiles()

Dim myCurrDir As String
Dim myFScript
Dim myFolder
Dim myFile
Dim myFileCollection
Dim myString
Dim mySheetName As String
Dim myCurrWkBk As String
myCurrDir = "C:\TestData\"
myCurrWkBk = ActiveWorkbook.Name

Set myFScript = CreateObject("Scripting.FileSystemObject")
Set myFolder = myFScript.GetFolder(myCurrDir)
Set myFileCollection = myFolder.Files


For Each myFile In myFileCollection
    Workbooks.Open (myCurrDir & "\" & myFile.Name)
    mySheetName = ActiveSheet.Name
    Range("A1").CurrentRegion.Copy
    Workbooks(myCurrWkBk).Sheets(1).Activate
    Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Workbooks(myFile.Name).Close savechanges:=False

Next


End Sub


cheers

Matt

Oops silly me, did I forget the Text to columns bit! Sorry


Sub mdl_ForEachFileInFiles()

Dim myCurrDir As String
Dim myFScript
Dim myFolder
Dim myFile
Dim myFileCollection
Dim myString
Dim mySheetName As String
Dim myCurrWkBk As String
myCurrDir = "C:\TestData\"
myCurrWkBk = ActiveWorkbook.Name

Set myFScript = CreateObject("Scripting.FileSystemObject")
Set myFolder = myFScript.GetFolder(myCurrDir)
Set myFileCollection = myFolder.Files


For Each myFile In myFileCollection
    Workbooks.Open (myCurrDir & "\" & myFile.Name)
    mySheetName = ActiveSheet.Name
    Range("A1").CurrentRegion.Copy
    Workbooks(myCurrWkBk).Sheets(1).Activate
    Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Workbooks(myFile.Name).Close savechanges:=False

Next

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), OtherChar:="|"
End Sub

Cheers

Matt