將多個文本文件導入Excel

Question

我需要將多個文本文件導入1個Excel工作表。 我嘗試了以下代碼，但僅完成了我需要的部分工作。 所有文本文件都在同一文件夾中，並且具有相同的名稱。 因此，它們是：測試（1），測試（2）等。

目標是：僅在1個excel工作表中導入所有文本文件； 文本文件應水平粘貼：excel中每個文本文件需要1行。 然后，文件內容應以文本格式粘貼。 您能幫我解決這個問題嗎？

Sub Files()

Dim myfiles
Dim i As Integer

myfiles = Application.GetOpenFilename(filefilter:="TEXT Files (*.txt), *.txt", MultiSelect:=True)
If Not IsEmpty(myfiles) Then
    For i = LBound(myfiles) To UBound(myfiles)
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myfiles(i), Destination:=range("A" & Rows.Count).End(xlUp).Offset(1, 0))
            .Name = "test"
            .FieldNames = False
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileColumnDataTypes = Array(xlGeneralFormat)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    Next i
Else
    MsgBox "No File Selected"
End If

End Sub

Answer 1

這應該為您做。

Sub ReadFilesIntoActiveSheet()

    Dim fso As FileSystemObject
    Dim folder As folder
    Dim file As file
    Dim FileText As TextStream
    Dim i As Long
    Dim cl As Range

    Set fso = New FileSystemObject
    Set folder = fso.GetFolder("C:\your_path\")

    Set cl = ActiveSheet.Cells(1, 1)

    Application.ScreenUpdating = False

    For Each file In folder.Files

        Set FileText = file.OpenAsTextStream(ForReading)
        cl.Value = file.Name
        i = 1

        Do While Not FileText.AtEndOfStream
            cl.Offset(i, 0).Value = FileText.ReadLine
            i = i + 1
        Loop

        FileText.Close

        Set cl = cl.Offset(0, 1)
    Next file

    Application.ScreenUpdating = True

    Set FileText = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub