多个文本文件分别拷贝到同一个Excel的不同Sheet

最新推荐文章于 2024-10-18 16:09:53 发布

转载最新推荐文章于 2024-10-18 16:09:53 发布 · 341 阅读

2 ·

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/Farseer1215/archive/2013/01/04/2844972.html

本文介绍了一段VBA代码，该代码能够将指定路径下的所有文本文件批量导入到Excel的不同工作表中，每个文本文件对应一个工作表，并以文件名作为工作表名称。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

遇到一个需求，需要将多个文件拷贝到同一个Excel的不同Sheet中，每个文本文件一个Sheet，Sheet的名字用文本文件的名字，使用VBA可以很方便地实现这个功能，不过一直对于VB的语法有些生疏，放在这里做备份。

Sub importTextFiles()
'
' Import Text Files to a Excel File.
'

'
Dim FilePath, FileName
FilePath = "D:\Items\"
FileName = Dir(FilePath + "*.txt")


Do While FileName <> ""

    Sheets.Add after:=Worksheets(Worksheets.Count)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & FilePath & FileName _
        , Destination:=Range("$A$1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(2, 1, 2, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A1:D1").Select
    Selection.Font.Bold = True
    ActiveSheet.Name = Left(FileName, Len(FileName) - 4)
    FileName = Dir()
    
Loop
End Sub

转载于:https://www.cnblogs.com/Farseer1215/archive/2013/01/04/2844972.html