Excel: Import files using VBA and name sheets after file name that is too long

Question

I have adapted a code I found on here, which pulls in text files and pastes the data into new sheets. This file is supposed to name the sheets the name of the text file, but my text file names are too big. It seems excel sheets can be 31 characters long. How can I adjust this code to name the sheets using the first 31 characters of the text file names?

I would also like for the code to prompt me to pick the folder destination. I've tried a few things, but haven't figured it out yet.

 Sub ImportManyTXTs_test() Dim strFile As String Dim ws As Worksheet strFile = Dir("I:\\path\\*.lev") Do While strFile <> vbNullString Set ws = Sheets.Add With ws.QueryTables.Add(Connection:= _ "TEXT;" & "I:\\path\\" & 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 = 437 .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1) .TextFileFixedColumnWidths = Array(22, 13, 13) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With strFile = Dir Loop End Sub 

Answer 1

Change .Name = strFile to

If Len(strFile) < 31 Then
   .Name = strFile
Else
   .Name = Mid(strFile, 1, 31)
End If

Answer 2

Use the LEFT() function to only get the first 31 characters of your filename, like so:

Sub ImportManyTXTs_test()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("I:\path\*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
    "TEXT;" & "I:\path\" & strFile, Destination:=Range("$A$1"))
    .Name = LEFT(strFile,31)
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlFixedWidth
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
    .TextFileFixedColumnWidths = Array(22, 13, 13)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub

Answer 3

I managed to figure out how to get it to prompt for a folder location, but neither of the above suggestions worked. The sheets are still getting default labels.

 Sub ImportManyTXTs_test() Dim foldername As String With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show On Error Resume Next foldername = .SelectedItems(1) Err.Clear On Error GoTo 0 End With Dim strFile As String Dim ws As Worksheet strFile = Dir(foldername & "\\" & "*.lev") Do While strFile <> vbNullString Set ws = Sheets.Add With ws.QueryTables.Add(Connection:= _ "TEXT;" & foldername & "\\" & strFile, Destination:=Range("$A$1")) .Name = Left(strFile, 31) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1) .TextFileFixedColumnWidths = Array(22, 13, 13) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With strFile = Dir Loop End Sub 

Answer 4

 ' using for each loop For Each ws In ThisWorkbook.Sheets ws.Rows("1:45").NumberFormat = "@" ws.Rows("1:45").Replace _ What:="=", Replacement:="", _ SearchOrder:=xlByColumns, MatchCase:=True Next For Each ws In ThisWorkbook.Sheets If Not IsEmpty(ws.Cells(16, 2).Value) Then ws.Name = ws.Cells(16, 2).Value End If Next 

I managed to solve my problem by adding this to the end of my code. My data files have a header which unfortunately uses a lot of "=" making excel import those items as equations. The instrument name is in the header which is what I want the sheets to be labelled.

Not sure why naming after file name wouldn't work.