Sheet name equal to name of input text file - excel

Question

Updated.
I have the following code:
Sub ImportTextFile()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Val(Application.Version) > 15 Then
If ActiveWorkbook.AutoSaveOn Then ActiveWorkbook.AutoSaveOn = False
End If
Dim Ret
Dim newWorksheet As Worksheet
Set newWorksheet = Sheets.Add(After:=Sheets("Konvertering"))
Ret = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If Ret <> False Then
With newWorksheet.QueryTables.Add(Connection:= _
"TEXT;" & Ret, Destination:=newWorksheet.Range("$A$1"))
.Name = "Sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
newWorksheet.Name = Mid$(Ret, InStrRev(Ret, "\") + 1)
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
It imports a textfile to a new sheet in Excel. How can I update the code so that the new sheet gets the same name as the textfile that was imported?

Answer 1

First, when adding the new worksheet, assign it to an object variable for reference later...
Dim newWorksheet As Worksheet
Set newWorksheet = Sheets.Add(After:=Sheets("Konvertering"))
Then, you can refer to the new worksheet for your query and name your new worksheet as follows...
If Ret <> False Then
With newWorksheet.QueryTables.Add(Connection:= _
"TEXT;" & Ret, Destination:=newWorksheet.Range("$A$1"))
'etc
'
'
End With
newWorksheet.Name = Mid$(Ret, InStrRev(Ret, "\") + 1)
End If

Answer 2

Double InstrRev
You were just another InstrRev away from the solution.
Let's say the path is C:\Test\Input.txt.
After applying InstrRev with \ to Ret ...
x = Mid$(Ret, InStrRev(Ret, "\") + 1)
you got this: Input.txt.
Now you just have to apply InstrRev with . to x ...
FileName = Mid$(x, 1, InStrRev(x, ".") - 1)
to get this: Input.
And now you have to get rid off x i.e. replace x in the second expression with the right side of the first expression to get this:
FileName = Mid$(Mid$(Ret, InStrRev(Ret, "\") + 1), 1, _
InStrRev(Mid$(Ret, InStrRev(Ret, "\") + 1), ".") - 1)
Hence the solution:
Replace this ...
newWorksheet.Name = Mid$(Ret, InStrRev(Ret, "\") + 1)
...with
newWorksheet.Name = Mid$(Mid$(Ret, InStrRev(Ret, "\") + 1), 1, _
InStrRev(Mid$(Ret, InStrRev(Ret, "\") + 1), ".") - 1)
...and you're done.
EDIT:
Links
Workbook.SaveAs
XlFileFormat
The Code
Option Explicit
Sub ImportTextFile()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' The following line is usually written immediately after the previous
' two lines.
On Error GoTo ProgramError
If Val(Application.Version) > 15 Then
If ActiveWorkbook.AutoSaveOn Then ActiveWorkbook.AutoSaveOn = False
End If
Dim Ret As Variant
Dim newWorksheet As Worksheet
Dim ws As Worksheet ' For Each Control Variable
Dim finishSuccess As Boolean
Dim fileName As String
Set newWorksheet = Sheets.Add(After:=Sheets("Konvertering"))
Ret = Application.GetOpenFilename("Text Files (*.txt), *.txt")
' Define fileName
fileName = Mid$(Mid$(Ret, InStrRev(Ret, "\") + 1), 1, _
InStrRev(Mid$(Ret, InStrRev(Ret, "\") + 1), ".") - 1)
' Check if fileName exceeds 31 character limit:
If Len(fileName) > 31 Then GoTo FileNameTooLong
' Check if worksheet name exists.
For Each ws In ThisWorkbook.Worksheets
If ws.Name = fileName Then GoTo WorksheetNameTaken
Next ws
' Import Text File
If Ret = False Then GoTo SafeExit
With newWorksheet.QueryTables.Add(Connection:= _
"TEXT;" & Ret, Destination:=newWorksheet.Range("$A$1"))
.Name = "Sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
newWorksheet.Name = fileName
' Stop Excel complaining about losing the code.
Application.DisplayAlerts = False
' Assuming you want to save the file as .xlsx (without code).
ThisWorkbook.SaveAs fileName, xlOpenXMLWorkbook
' If you want to save as .xlsm (with code) then use
' 'xlOpenXMLWorkbookMacroEnabled' and remove the lines
' containing 'Application.DisplayAlerts ...'.
Application.DisplayAlerts = True
' If I'm mmissing the point, just outcomment the previous Application
' block and uncomment the following line and make changes appropriately.
' Thisworkbook.SaveAs fileName, xlOpenXMLWorkbookMacroEnabled
finishSuccess = True
SafeExit:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
If finishSuccess Then
MsgBox "Finished successfully.", vbInformation, "Success"
' Close workbook without saving changes (False) ensuring that it
' always stays the same. Remove 'False' if I'm missing the point.
ThisWorkbook.Close False
End If
Exit Sub
WorksheetNameTaken:
MsgBox "There is already a worksheet named '" & fileName & "'.", _
vbInformation, "Custom Error Message"
GoTo SafeExit ' or change appropriately.
FileNameTooLong:
MsgBox "The file name '" & fileName & "' exceeds the 31 character limit.", _
vbInformation, "Custom Error Message"
GoTo SafeExit ' or change appropriately.
ProgramError:
' Handle Error (You can do better. A hint: 'vbYesNo'.)
MsgBox "An unexpected error occurred. Error '" & Err.Number & "': " _
& Err.Description, vbCritical, "Custom Error Message"
On Error GoTo 0
GoTo SafeExit ' or change appropriately.
End Sub