TextToColumn VBA

[Xander117]

Okay so made a few changes to Andrew's code that I found on here. I have no issues listing the files in the folders and subfolders with the information I want. I also wanted to automated the text to column portion which is where I am having issues. Here is what I have

Sub TestListFilesInFolder()
    Workbooks.Add ' create a new workbook for the file list
    Range("A1").Formula = "File Type:"
    Range("B1").Formula = "Date Last Modified:"
    Range("C1").Formula = "File Size:"
    Range("D1").Formula = "File Name:"
    ListFilesInFolder "C:\Users\*.*\desktop", True
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean) ' requires Microsoft Scripting Runtime to be on
    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range("A65536").End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        Cells(r, 1).Formula = FileItem.Type
        Cells(r, 2).Formula = FileItem.DateLastModified
        Cells(r, 3).Formula = FileItem.Size
        Cells(r, 4).Formula = FileItem.Path
        r = r + 1
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Columns("A:H").AutoFit
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
 
    Columns("D:D").Select
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1)), TrailingMinusNumbers:=True
End Sub

It works till I get to a subfolder within the target folder, I am assuming it has something to do with the Range being set to D1. Can anyone help with the text to column portion of the code? Thanks.

 

[p45cal]

You're including the text-to-columns part within the part which recurses. You already have a separate macro to put headers in the new workbook, why not move the last two lines of the ListFilesInFolder to the end of TestListFilesInFolder, so it will only be executed once?

 

[Xander117]

One of those days....Thanks P45 worked like a champ.