根据工作表中包含的数据连接重命名工作表

Question

我有100个.txt文件。每个.txt都连接到工作簿中的不同工作表。我想根据该表中连接的.txt文件的名称来命名工作表。

以下是一些代码。 不幸的是，他们没有工作，因为我收到了错误：“已经取名”

    Sub MultipleTextFilesIntoExcelSheets()
Dim i As Integer 'a counter to loop through the files in the folder
Dim fname As String, FullName As String 'fname is the name of the file, and FullName is the name of its path
Dim ws As Worksheet 'a workbook object for the workbook where the current macro is running


''' Delete existing data connections
''''''''''''''''''''''''''''''''''''
Do While ActiveWorkbook.Connections.Count > 0
ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
Loop


''' Rename raw data sheets to default string
''''''''''''''''''''''''''''''''''''''''''''
i = 1

For Each ws In Worksheets
If ws.Name Like "Test1" Or ws.Name Like "Test2*" = True Then
'Do Nothing
ElseIf ws.Name Like "Test1" Or ws.Name Like "Test2*" = False Then
ws.Name = "Sheet" & i
i = i + 1 'get ready for the next iteration
End If
Next ws


''' Import .txt files
'''''''''''''''''''''
i = 0

'get the name of the first text file
fname = Dir("C:\Sample\Test\*txt")

'loop through the text files to put them onto separate sheets in the Excel book
While (Len(fname) > 0)
'get the full path of the text file
FullName = "C:\Sample\Test\" & fname
i = i + 1  'get ready for the next iteration

Set ws = ThisWorkbook.Sheets("Sheet" & i) 'the current sheet

With ws.QueryTables.Add(Connection:="TEXT;" & FullName, Destination:=ws.Range("A1"))
    .Name = fname
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True    'we are using a tab-delimited file
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileOtherDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
    fname = Dir
End With
Wend


''' Rename sheets to new string
'''''''''''''''''''''''''''''''
For Each ws In Worksheets
If ws.Name Like "Test1" Or ws.Name Like "Test2*" = True Then
'Do Nothing

ElseIf (ws.Name Like "Test1" Or ws.Name Like "Test2*" = False) Then
ws.Name = Left(fname, (Len(fname) - 4))
End If

Next ws
End Sub

提前谢谢你， FEDE

Answer 1

您使用Dir一次将初始值放入fname，但之后永远不会更改此初始值。在第二次循环中，你仍然使用相同的fname，因此Excel抱怨你使用的是已经被占用的名字。

可能可以在fname = Dir之前插入行Next ws。这似乎是你想要的，虽然我对你的代码的整体逻辑感到不舒服，因为它不清楚它如何保证正确的名称与正确的表格一致。编写一个以最初为空的工作簿开头的子文件，并遍历导入数据的文件夹并在一次传递中命名工作表可能更有意义。

另外 - 我认为你ElseIf的逻辑是阴暗的。首先，为什么不是一个简单的Else？

Answer 2

如果我理解正确，您需要在更新fname之前将工作表的重命名移动到while循环中。 （当您已经知道需要重命名哪个工作表时更新工作表）