使用 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