Hi all,

I am trying to open txt files to pull into my workbook. I have code that works fine if all the text files are in the same folder. I was thinking of writing code to copy them over however I wondered if there was a more elegant way to do it.

I would like to search all sub folders but am up for naming them. I have (unsuccessfully) written a few things that nearly do it but they all fall over.


    sMyPath = "C:\Users\test\Desktop\"

    sFilesInPath = Dir(sMyPath & "*Test*")
    If sFilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

        FNum = 0
        Do While sFilesInPath <> ""
            FNum = FNum + 1
            ReDim Preserve sMyFiles(1 To FNum)
            sMyFiles(FNum) = sFilesInPath
            sFilesInPath = Dir()
        Loop


        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        Set BaseBk = ActiveWorkbook
        lRowNum = 1
'        MsgBox BaseBk.Name & " " & BaseWks.Name

        If FNum > 0 Then
            For FNum = LBound(sMyFiles) To UBound(sMyFiles)
                Set MyBook = Nothing
                Set MySheet = Nothing
                On Error Resume Next

                Workbooks.OpenText Filename:=(sMyPath & sMyFiles(FNum)), Origin:=xlMSDOS, _
                StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(7, _
                1), Array(12, 1), Array(21, 1), Array(32, 1), Array(39, 1), Array(40, 1), Array(49, 1), _
                Array(57, 1), Array(60, 1), Array(64, 1), Array(69, 1), Array(73, 1), Array(81, 1), Array( _
                105, 1), Array(125, 1)), TrailingMinusNumbers:=True
                
                Set MyBook = Workbooks(sMyFiles(FNum))
                Set rDynamic = MyBook.Sheets(sMyFiles(FNum)).Range("A1")
                
                If Not MyBook Is Nothing Then
                    On Error Resume Next
    
                    ' Change this range to fit your own needs.
                    With MyBook.Sheets(sMyFiles(FNum))
                        Set rSource = .Range("A1", Range("A1").SpecialCells(xlLastCell))
                    End With