Extract data from multiple text files and renaming the files

[DevC]

Hi,

I have 150 ".LST" text files. I want to extract the same into an excel file. But the text files are having lengthy names, so I need to rename the files so that it is within the limits of work sheet name length. I am using the below mentioned code but after sometime, as error is showing that "Common File Name are available". Also I am unable to rename the text files. Please guide.

Sub Test()

'UpdatebyExtendoffice6/7/2016

Dim xWb As Workbook

Dim xToBook As Workbook

Dim xStrPath As String

Dim xFileDialog As FileDialog

Dim xFile As String

Dim xFiles As New Collection

Dim I As Long

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

xFileDialog.AllowMultiSelect = False

xFileDialog.Title = "Select a folder [Kutools for Excel]"

If xFileDialog.Show = -1 Then

xStrPath = xFileDialog.SelectedItems(1)

End If

If xStrPath = "" Then Exit Sub

If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"

xFile = Dir(xStrPath & "*.lst")

If xFile = "" Then

MsgBox "No files found", vbInformation, "Kutools for Excel"

Exit Sub

End If

Do While xFile <> ""

xFiles.Add xFile, xFile

xFile = Dir()

Loop

Set xToBook = ThisWorkbook

If xFiles.Count > 0 Then

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

On Error Resume Next

ActiveSheet.Name = xWb.Name

On Error GoTo 0

xWb.Close False

Next

End If

End Sub

 

[JLGWhiz]

ActiveSheet.Name = xWb.Name

Try change the above to this

ActiveSheet.Name = xFiles(I)