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

【问题标题】：Rename sheet based on data connection contained in the sheet根据工作表中包含的数据连接重命名工作表
【发布时间】：2015-07-22 11:53:10
【问题描述】：

我有 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

提前谢谢你，费德

【问题讨论】：

连接到每个工作表是什么意思？它们是如何连接的？
.txt 文件已使用“数据”功能区 -->“来自文本”连接。希望这可以澄清。谢谢。
您用于导入文本文件的过程是什么？你是手动做的吗？还是由 vba 完成的？
将 fname = Dir("C:\test*txt") 更改为 fname = Dir("C:\test*.txt")

标签： vba excel

【解决方案1】：

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

可能在 Next ws 之前插入行 fname = Dir。这似乎是您想要的，尽管我对您的代码的整体逻辑感到不舒服，因为尚不清楚它如何保证正确的名称与正确的工作表搭配。编写一个从最初为空的工作簿开始并遍历文件夹导入数据并一次性命名工作表的 sub 可能更有意义。

另外——我认为你的ElseIf 的逻辑很模糊。一方面——为什么不简单的Else？

【讨论】：

您好约翰，感谢您的回答。 fname = Dir 之前不起作用：“无效的过程调用”。此外，要回答您对我的编码的评论：我需要一些将 .txt 文件名附加到工作表名称的编码。对“正确的名称与正确的工作表”不感兴趣，因为我在建立数据连接后插入工作表名称。希望这会有所帮助。
也许结合 MatthewD 的建议。您的初始目录似乎有问题。
仍然错误。我应该使用while循环吗？我的意思是，我怎么能要求 vba 将第二个 .txt 用于工作表，将第三个 .txt 用于工作表 3 等？谢谢。
也许您在用完工作表之前就用完了文件。使用 Dir 时的典型习惯用法是在每次通过循环时测试其返回，并在为空时终止。你应该测试它的价值。您可以将代码重构为 while 循环——或者如果需要，可以提前测试并退出 for 循环。将一个简单的Debug.Print fname 放在循环的顶部并看看你得到了什么不会有什么坏处。
能否请您帮我设置循环？谢谢

【解决方案2】：

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

【讨论】：