将所有文本文件加载到一个工作表?

时间:2012-04-09 15:53:17

标签: vba excel-2010

在Excel 2010中,我想将文件夹中的所有文本文件数据加载到一个工作表中。

每张工作表都应包含一个文本文件的数据。

每个工作表都是在第一行上用标题分隔的管道。

更新宏

Sub LoadTextFilesLoop()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet

    Set objFSO = CreateObject("Scripting.FileSystemObject")
     'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder("C:\Export\")
     'Loop through the Files collection
    For Each objFile In objFolder.Files
    NewFileImport (objFile.Name)
    Next
     'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
End Sub

Sub NewFileImport(FileName)
    Sheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Export\FileName", _
        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 = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

循环未加载数据。

我仍然需要弄清楚如何获得每个文件中的列数。

.TextFileColumnDataTypes = Array(1, 1, 1)

此行告诉此文件中的三列。这应该根据文件列而有所不同。

1 个答案:

答案 0 :(得分:0)

最后我得到了这个  这是我的宏。

Sub LoadTextFilesLoop()
Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet

    Set objFSO = CreateObject("Scripting.FileSystemObject")
     'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder("C:\Export\")
     'Loop through the Files collection
    For Each objFile In objFolder.Files
    NewFileImport (objFile.Name)
    Next
     'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
    End Sub

Sub NewFileImport(FileName)
Dim fName As String
fName = Left(FileName, Len(FileName) - 4)
Sheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Export\" + FileName, _
        Destination:=Range("$A$1"))
        .Name = fName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveSheet.Select
    ActiveSheet.Name = Left(fName, 31)
End Sub