1

I am trying to open a folder with a button, select Text Files and read the files into my current workbook.

My workbook has worksheets. A worksheet for each file should be added at the end of my sheets.

I found a code that reads as I want but it opens a new workbook.

Sub fileop()
    Dim xFilesToOpen As Variant
    Dim i As Integer

    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String

    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Error", , True)

    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Error"
        GoTo ExitHandler
    End If

    i = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(i))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    xWb.Worksheets(i).Columns("A:A").TextToColumns _
    Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=False, _
    Other:=True, OtherChar:="|"

    Do While i < UBound(xFilesToOpen)
        i = i + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(i))
        With xWb
            xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
            .Worksheets(i).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=xDelimiter
        End With
    Loop

ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Error"
    Resume ExitHandler

End Sub
Community
  • 1
  • 1
  • The problem looks as if it might be that `xTempWb` and `xWb` are referring to the same workbook. When you open a workbook it becomes the active workbook. – SJR Dec 20 '18 at 09:46
  • Plus you copy but never actually paste. – SJR Dec 20 '18 at 09:49
  • Do you think there is a easier way to open a folder, read all files i select and put them into my current project to the last sheets? – Fabian Linek Dec 20 '18 at 10:04

2 Answers2

0

Here you go.

Sub TxtImporter()
Dim f As String, flPath As String
Dim i As Long, j As Long
Dim ws As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
flPath = ThisWorkbook.Path & Application.PathSeparator
i = ThisWorkbook.Worksheets.Count
j = Application.Workbooks.Count
f = Dir(flPath & "*.txt")
Do Until f = ""
    Workbooks.OpenText flPath & f, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
        Space:=False, Other:=False, TrailingMinusNumbers:=True
    Workbooks(j + 1).Worksheets(1).Copy After:=ThisWorkbook.Worksheets(i)
    ThisWorkbook.Worksheets(i + 1).Name = Left(f, Len(f) - 4)
    Workbooks(j + 1).Close SaveChanges:=False
    i = i + 1
    f = Dir
Loop
Application.DisplayAlerts = True
End Sub
ASH
  • 20,759
  • 19
  • 87
  • 200
  • Thanks for the response. Sadly this is not what i am looking for. I want to press a button in excel (that should open a folder) and than select as many texfiles as i want. After that the textfiles should be placed in the same excel workbook but always in the last position of my sheet (for every textfile a new sheet) – Fabian Linek Jan 03 '19 at 10:27
-1

You open a new Worksbook to insert the file. You Need only to open a Textfile and insert it at the last cell.

You will find examples to determine the last cell here https://www.excelcampus.com/vba/find-last-row-column-cell.

Opening a Textfile, you will find here reading entire text file using vba.

Kostarsus
  • 37
  • 5