Rename sheet based on data connection contained in the sheet - vba

Question

I have 100 .txt files. Each .txt is connected to a different sheet in the workbook. I would like to name the sheet based on the name of .txt file connected in that sheet.
Here are some code.
Unfortunately they do not work as I got the error: "name already taken"
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
Thank you in advance,
Fede

Answer 1

You use Dir once to put an initial value into fname but then never change this initial value. In the second pass through the loop you are still using the same fname, hence Excel complains that you are using a name that is already taken.
It might work to insert the line fname = Dir right before Next ws. This would seem to be what you want, though I am uncomfortable with the overall logic of your code since it isn't clear how it guarantees that the right name goes with the right sheet. It might make more sense to write a sub that starts with an initially empty workbook and iterates through the folder importing the data and naming the sheets in one pass.
Also -- I think the logic of your ElseIf is murky. For one thing -- why not a simple Else?

Answer 2

If I understand correctly you will need to move the renaming of the sheets into your while loop prior to updating fname. (Update the sheet when you already know which sheet needs to be renamed)