OpenText

[tuli1954]

Hello,

I am trying to import a number of text files in one sheet.

If I am using the line below, a new workbook will open. How can I import a text file in an open excel workbook?

Workbooks.OpenText Filename:=fln, Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
Array(0, 1), Array(12, 1), Array(26, 1), Array(45, 1), Array(66, 1), Array(86, 1), Array( _
106, 1), Array(126, 1)), TrailingMinusNumbers:=True

Thank you

 

[Yongle]

You could try something like this,
- which places the data in the next available row (finding last occupied cell in column A) in SheetX
- multiple files can be selected from the same folder
- no attempt made to optimise the code (it is writing one row at a time to the worksheet)

Sub ReadTextFile()
    Dim myFile As Variant, myFiles As Variant, text As String, textline As String, cel As Range
    myFiles = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", MultiSelect:=True)
    For Each myFile In myFiles
        Open myFile For Input As #1
        Do Until EOF(1)
            Line Input #1, textline
            Set cel = Sheets("SheetX").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            cel.Value = textline
            cel.TextToColumns Destination:=cel, DataType:=xlFixedWidth, _
                FieldInfo:=Array(Array(0, 1), Array(12, 1), Array(26, 1), Array(45, 1), Array(66, 1), Array(86, 1), Array(106, 1), Array(126, 1)), _
                TrailingMinusNumbers:=True
        Loop
        Close #1
    Next myFile
End Sub

 

[tuli1954]

Thank you, will try

 

[tuli1954]

hello, I get this error after 3 lines

 

[Yongle]

Something strange is going on in column A

Try this which uses a different method to determine next row

Delete prior code and replace with this

Sub ReadTextFile()
    Dim myFile As Variant, myFiles As Variant, text As String, textline As String, cel As Range, ws As Worksheet
    Set ws = ActiveSheet
    myFiles = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", MultiSelect:=True)
    For Each myFile In myFiles
        Open myFile For Input As #1
        Do Until EOF(1)
            Line Input #1, textline
            Set cel = ws.Cells(Split(ws.UsedRange.Address, "$")(4) + 1, 1)
            cel.Value = textline
            cel.TextToColumns Destination:=cel, DataType:=xlFixedWidth, _
                FieldInfo:=Array(Array(0, 1), Array(12, 1), Array(26, 1), Array(45, 1), Array(66, 1), Array(86, 1), Array(106, 1), Array(126, 1)), _
                TrailingMinusNumbers:=True
        Loop
        Close #1
    Next myFile
End Sub