使用VBA宏导入多个文本文件 [英] Importing multiple text files using VBA Macro

问题描述

我每天都会转储2个不同的文本文件(在同一文件夹中)，这些文件每天都会被覆盖.我希望能够将它们导入带有制表符分隔的活动电子表格中，同时使用VBA代码.我非常感谢您的帮助！

I have a daily dump of 2 different text files (in the same folder) that get overwritten daily. I would like to be able to import them into an active spreadsheet with tab delimited, at the same time with a VBA code. I would really appreciate the help!

我正在使用excel2016.我的文本文件1的手动导入方法在记录时给出了以下代码，这就是我希望同时导入文本文件(保留格式的原因)的方法:

I am using excel 2016. My manual import method of 1 of the text file when recorded gives this code which is how i would like BOTH the text files to be imported (formatting preserved):

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

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

The code that i have tried using is from other similar questions posted here does not seem to work:

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

推荐答案

如果您的文本文件用制表符分隔，请执行以下操作.

do like this if your text files is with tab delimited.

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

在第二个文本文件中，标题将被忽略.

From the second text file, the header will be ignored.

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

这篇关于使用VBA宏导入多个文本文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！