2017-07-26 59 views
0

我试图制作一个可以从文件夹中导入* txt文件的宏,我做了它。现在我困在此:将* txt导入到工作表并将其命名为* 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 

回答

0

后 “结束与” 后,尝试:

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

srtFile = Dir 
1

添加一行代码的附加行

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

这工作很好,谢谢! – ARGC

0

最终代码:

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 
相关问题