将* txt导入到工作表并用* txt文件名命名

我试图做一个macros,可以从一个文件夹中导入* txt文件,我做到了。 现在我被困在这个:

我需要命名与* txt文件同名的工作表。 实际的代码是作为新工作表的默认名称导入的。

Sub ImportTXT() Dim strFile As String Dim ws As Worksheet strFile = Dir("A:\REPORTS\2017\*.txt") Do While strFile <> vbNullString Set ws = Sheets.Add With ws.QueryTables.Add(Connection:= _ "TEXT;" & "A:\REPORTS\2017\" & strFile, Destination:=Range("$A$1")) .Name = strFile .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 = xlFixedWidth .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 4, 4, 4, 9) .TextFileFixedColumnWidths = Array(14, 10, 6, 11, 43, 15, 33, 14, 1, 14, 16, 4, 13, 11, _ 11, 10) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With strFile = Dir Loop End Sub 

在添加行之后添加一行代码

 Set ws = Sheets.Add ws.Name = strFile With ws.QueryTables.Add(... 

在“结束”之后,尝试:

 Set ws = ThisWorkbook.ActiveSheet ws.Name = Left(srtFile, Len(srtFile) - Len(".txt")) srtFile = Dir 

最终代码:

 Dim strFile As String Dim ws As Worksheet strFile = Dir("A:\REPORTS\2017\*.txt") Do While strFile <> vbNullString Set ws = Sheets.Add ws.Name = strFile With ws.QueryTables.Add(Connection:= _ "TEXT;" & "A:\REPORTS\2017\" & strFile, Destination:=Range("$A$1")) .Name = strFile .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 = xlFixedWidth .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 4, 4, 4, 9) .TextFileFixedColumnWidths = Array(14, 10, 6, 11, 43, 15, 33, 14, 1, 14, 16, 4, 13, 11, _ 11, 10) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With strFile = Dir Loop End Sub