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

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

1 个答案: