Visual Basic：将多个文本文件导入多个工作表

Question

所有数据都存储在文本文件中。我有多个这样的文件，我想将每个文件导入一个带有文件名的新工作表中。

我录制了一个宏，以便将数据导入到正确的规范中。之后，我添加了对目录中的每个文件重复此过程的部分。

我的代码的结果是它为每个文件创建了一个具有正确名称的新工作表，但工作表是空的。

Sub ImportTextfiles()
    Dim folderName As String, filePathName As String, FileName As String

    folderName = "C:\Users\MyName\Documents\MultipleFiles\"
    FileName = Dir(folderName, vbNormal)

    While FileName <> ""
        filePathName = folderName & FileName
        Sheets.Add.Name = FileName
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & filePathName, _
            Destination:=Range("$A$1"))
            .Name = FileName
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 1251
            .TextFileStartRow = 1
            .TextFileParseType = xlFixedWidth
            .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, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileFixedColumnWidths = Array(37, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, _
        10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, _
        10, 10, 10, 10, 10)
            .TextFileDecimalSeparator = "."
            .TextFileThousandsSeparator = ","
        End With
        FileName = Dir()
    Wend

End Sub

Answer 1

你们很亲密。录制宏是开始学习编写自己的自定义函数脚本的绝佳方式。在这种情况下，您没有使用正在添加的新工作表。所以添加新工作表，正确命名，然后使用该工作表导入数据。

Option Explicit

Sub ExtDataToSheets()
    Dim fnames() As String
    Dim fname As Variant
    Dim fullpath As String
    Dim newSh As Worksheet

    fnames = Split("file1.txt,file2.txt,file3.txt", ",")

    For Each fname In fnames
        fullpath = Application.Path & fname
        Set newSh = ActiveWorkbook.Sheets.Add
        newSh.Name = fname
        With newSh.QueryTables.Add(Connection:="TEXT;C:\Temp\SampleData.csv", _
            Destination:=Range("$A$1"))
            .Name = "SampleData"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    Next fname
End Sub