使用VBA宏导入多个文本文件

Question

我每天都会转储2个不同的文本文件（在同一个文件夹中），每天都会被覆盖。我希望能够将它们导入到带有制表符分隔的活动电子表格中，同时使用VBA代码。我真的很感激你的帮助！

我正在使用excel 2016.我记录的文本文件中的1个手动导入方法给出了这个代码，这就是我想要导入的文本文件（保留格式）：

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Mr D\Music\New folder\B.txt", Destination:=Range("$A$1"))
        .CommandType = 0
        .Name = "B"
        .FieldNames = True
        .RowNumbers =enter code here False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

我尝试使用的代码来自此处发布的其他类似问题似乎不起作用：

Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range

' Get a FileSystem object
Set fso = New FileSystemObject

' get the directory you want
Set folder = fso.GetFolder("C:\Users\Mr D\Music\")

' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)

' Loop thru all files in the folder
For Each file In folder.Files
    ' Open the file
    Set FileText = file.OpenAsTextStream(ForReading)

    ' Read the file one line at a time
    Do While Not FileText.AtEndOfStream
        TextLine = FileText.ReadLine

        ' Parse the line into | delimited pieces
        Items = Split(TextLine, "|")

        ' Put data on one row in active sheet
        For i = 0 To UBound(Items)
            cl.Offset(0, i).Value = Items(i)
        Next

        ' Move to next row
        Set cl = cl.Offset(1, 0)
    Loop

    ' Clean up
    FileText.Close
Next file

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

End Sub

Answer 1

如果文本文件带有制表符分隔符，请执行此操作。

Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
Dim sFolder As String, vDB, Ws As Worksheet
Dim rngT As Range
' Get a FileSystem object
Set fso = New FileSystemObject

    ' get the directory you want

    sFolder = "C:\Users\Mr D\Music\"
    Set folder = fso.GetFolder(sFolder)
    ' set the starting point to write the data to
    Set Ws = ActiveSheet
    'Set cl = ActiveSheet.Cells(1, 1)

    ' Loop thru all files in the folder
    For Each file In folder.Files
        Workbooks.Open Filename:=sFolder & file.Name, Format:=1
        With ActiveWorkbook.ActiveSheet
            vDB = .UsedRange
        End With
        ActiveWorkbook.Close
        Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2)
        rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
    Next file
    Ws.Range("a1").EntireRow.Delete
    Set FileText = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub

从第二个文本文件中，标题将被忽略。

Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
Dim sFolder As String, vDB, Ws As Worksheet
Dim rngT As Range
' Get a FileSystem object
Set fso = New FileSystemObject

    ' get the directory you want

    sFolder = "C:\Users\Mr D\Music\"
    Set folder = fso.GetFolder(sFolder)
    ' set the starting point to write the data to
    Set Ws = ActiveSheet
    'Set cl = ActiveSheet.Cells(1, 1)
    Ws.Cells.Clear
    ' Loop thru all files in the folder
    For Each file In folder.Files
        i = i + 1
        Workbooks.Open Filename:=sFolder & file.Name, Format:=1
        With ActiveWorkbook.ActiveSheet
            If i = 1 Then
                vDB = .UsedRange
            Else
                vDB = .UsedRange.Offset(1)
            End If
        End With
        ActiveWorkbook.Close
        Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2)
        rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
    Next file
    Ws.Range("a1").EntireRow.Delete
    Set FileText = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub