将多个文本文件的第二行导入Excel

时间:2017-06-30 15:23:24

标签: excel-vba vba excel

我想从第2行开始将文件夹中多个制表符分隔文本文件的第二行导入excel。

我已经录制了一个宏,它从第2行开始将单个制表符分隔文本文件的第2行导入excel。(我在Excel工作表中有一个标题行)。我还找到了将多个文本文件导入excel的代码。我把它们放在一起很麻烦。我想将多文件导入功能添加到我录制的宏中。

以下是我记录的代码,它将单个文本文件的第二行导入excel中的第2行。我希望此代码将第二行多个文本文件导入Excel,从第2行开始,然后第3行等...

Sub Import()
'
' Import Macro
'

'
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;C:\Users\t830439\Desktop\test\BTWP004217_2017_6_29_12'14'03'0001.upl", _
    Destination:=Range("$A$2"))
    .CommandType = 0
    .Name = "BTWP004217_2017_6_29_12'14'03'0001"
    .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 = 2
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierNone
    .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, 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)
    .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\t830439\Desktop\test")

' set the starting point to write the data to
Set cl = ActiveSheet.Cells(2, 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

感谢。

EDIT - UPDATE --------------------------------------------

我已合并代码,但无法将其转到Loop。

Sub ReadFilesIntoActiveSheet3()
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\t830439\Desktop\test")

' set the starting point to write the data to
Set cl = ActiveSheet.Cells(2, 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)



     With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;C:\Users\t830439\Desktop\test\BTWP004217_2017_6_29_12'14'03'0001.upl", _
    Destination:=Range("$A$2"))
   ' .CommandType = 0
    .Name = "BTWP004217_2017_6_29_12'14'03'0001"
    .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 = 2
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierNone
    .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, 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)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

    Loop

    ' Clean up
    FileText.Close
Next file

Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

这个怎么样?

unserialize()

https://www.rondebruin.nl/win/s3/win008.htm