Question

我需要将多个文本文件导入到1个Excel工作表中。我尝试了下面的代码，但它只完成了我需要的部分工作。所有文本文件都在同一文件夹中，并且具有相同的名称。因此，它们是：test（1），test（2），.. etc。

目标是：只导入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

将多个文本文件导入excel

1 个答案: