Excel VBA: Как прочитать несколько текстовых файлов в лист Excel

Question

Я пытаюсь открыть папку с помощью кнопки, выбрать несколько текстовых файлов и прочитать все файлы в моей текущей книге.В моей рабочей книге уже есть несколько рабочих листов, и новые файлы должны быть открыты в конце моих листов.Я нашел код, который читается так, как я хочу, но он открывает новую книгу и не записывает ее в мой текущий проект.Может кто-нибудь, пожалуйста, помогите мне?Вот код, который я нашел, например:

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

Answer 1

Вот, пожалуйста.

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

Answer 2

Вы открываете новую книгу для вставки файла.Вам нужно только открыть текстовый файл и вставить его в последнюю ячейку.

Здесь вы найдете примеры для определения последней ячейки https://www.excelcampus.com/vba/find-last-row-column-cell.

Открыв текстовый файл, вы найдете здесь чтение всего текстового файла с использованием vba .