Import Text File using the Path & File Name in a Cell/Named Range

[Shiseiji]

The goal is to import a text file using the path and file name contained in a cell that's a named range.
I have a macro that I use daily to import a text file. The macro asks for the specific file to be imported. I would like to import the files without user input. The files to import are always the newest file and the next to newest file to two different worksheets for comparison of changes.
I have adapted a macro to list all the files in a specific folder on a worksheet and sort them in descending date order. Thus the newest file will always be in cell C1/ range "cel_Admin1Path" and the second oldest newest in cell C2/ range "cel_Admin2Path"
I've pared the code down to what I think is the minimum required to ease troubleshooting. My plan is to create a second macro for the second file. KISS. Once it's working ?

Deeply appreciate a review of the code and why it's not working.

TIA

Ron
?

Sub m_ImportAdminTextGivenLocation()
    ' 9-24-20
    ' Import the admin user account list
    ' Use path and file name from worksheet ws_FileList Range cel_Admin1Path
    '--ensure the worksheet is clear and named properly
    '
    Application.DisplayAlerts = True
    ws_3Admin.Name = "Admin Accounts"
    ws_3Admin.Activate
    Cells.Clear
    ws_3Admin.Visible = True
    '
    Dim ThisWb                      As Workbook
    Dim ThisWs                      As Worksheet
    fileToOpen = Range("cel_Admin1Path")
    '
    Set ThisWb = ActiveWorkbook
    Set ThisWs = ActiveSheet
    '
'--Start import text file---------------------------------------------------------
    With ThisWs.QueryTables.Add(Connection:="TEXT;" & fileToOpen, Destination:=Range("$A$1"))
        .Name = fileName
        .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 = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "^"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        '.Refresh BackgroundQuery = False
'--End import text file--
'--Delete external query range name--
    For Each qtbl In ThisWs.QueryTables
    qtbl.Delete
    Next
'--End Delete external query range name --
    End With 'ThisWs
    Cells(1, 1).Select
'-------------------------------------------------------------------
End Sub

Edit added by Admin:
Apologies, the cell value is C:\Users\me\Documents\AD\Raw_AD_Admin\AD_Admin_Accounts_09-23-2020-0553.txt

 

[Shiseiji]

Solution is posted to mark the question answered and maybe help others.
Notes:
_tm = "test Macro" and Properties Name is "tm_AutoImportAdmin" as a KISS name management.
All files in a specified directory have been listed on a worksheet code named ws5_AdminFileList. See code below.
The script that creates the text file being imported puts the type records retrieved and a date-time stamp on the last row. This is used in naming the worksheet.

Sub AutoImportAdmin_tm()
'10-28-20
'Yea, works!!!!
'
'https://www.mrexcel.com/board/threads/importing-new-txt-files-automatically.605958/page-2#posts
'https://www.reddit.com/r/excel/comments/8jfebv/find_most_recent_file_in_folder_based_on_partial/
'https://stackoverflow.com/questions/10975498/import-to-excel-a-text-file-using-cell-value
'----
    Application.DisplayAlerts = False
    ws_3Admin.Name = "Admin Accounts"
    ws_3Admin.Activate
    Cells.Clear
    Range("A1").Select
    Application.ScreenUpdating = True
    Application.StatusBar = "Starting import of Admin Accounts."
    Application.ScreenUpdating = True
    Call m_DeleteAllBadNamesThisWb
    Call DeleteConnectionQuery_tm
'---------------------
    Dim ThisWb As Workbook
    Dim ThisWs As Worksheet
    Dim QT As QueryTable
    Dim fileName As String
    Dim NewFile As String
'---------------------
    Set ThisWb = ActiveWorkbook
    'Set ThisWs = ActiveSheet
     Set  ThisWs = ws_3Admin
'-------------------
    NewFile = ws5_AdminFileList.Range("B1").Value
        For Each QT In ws_3Admin.QueryTables
            QT.Connection = newFolderPath
        Next
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & NewFile, Destination:=Range("$A$1"))
        .Name = fileName
        .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 = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "^"
        .TextFileColumnDataTypes = Array(1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 1, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery = False
    End With
    Set FileSys = Nothing
    Set myFolder = Nothing
    ThisWs.QueryTables(1).Delete
'-- Start naming worksheet
    Dim LastRow     As Long
    Dim LastCol     As Integer
    Dim ThisWsName  As Range
    Dim ThisWsDate  As Range
 '
    With ThisWs
        LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
        LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
        Set ThisWsName = Cells(Rows.Count, "A").End(xlUp)
      ThisWs.Name = ThisWsName.Value
      ThisWsName.Clear
End With 'ThisWs
'--End Naming Worksheet--
    Cells(1, 1).Select
    ws_3Admin.Visible = xlSheetVisible
BeforeExit:
    Application.ScreenUpdating = True
    Application.OnTime Now + TimeSerial(0, 0, 0.1), "m_ClearStatusBar"
    Application.StatusBar = "Done importing User Accounts."
    Application.OnTime Now + TimeSerial(0, 0, 10), "m_ClearStatusBar"
    '
'-------------------------------------------------------------------
End Sub

Code that retrieves the files in a specified directory

Sub ListUserFilesInFolder_tm()
  '10-29-20
  'Working! Yea!
  ' https://stackoverflow.com/questions/32359502/using-filesystemobject-to-list-files-getting-error
'--
    Application.DisplayAlerts = False
    ws4_UserFileList.Name = "User File List"
    ws4_UserFileList.Activate
    Cells.Clear
    Range("A1").Select
    Application.ScreenUpdating = True
    Application.StatusBar = "Starting list of File names."
    Application.ScreenUpdating = True
    Call m_DeleteAllBadNamesThisWb
    Call DeleteConnectionQuery_tm
'--
    Dim ThisWb As Workbook
    Dim ThisWs As Worksheet
'--
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim lngCnt As Long
    Dim dValue As Variant
    Dim X
    '
'--
    Set ThisWb = ActiveWorkbook
    'Set ThisWs = ActiveSheet
    Set ThisWs = ws4_UserFileList
    '
    dValue = Format(Date, "mm-dd")
    ThisWs.Name = "User File List " & dValue
    '
    objFolderName = "C:\Users\me\Documents\TestAD\Raw_AD_Users\"

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(objFolderName)
    Set ThisWb = ActiveWorkbook
    Set ThisWs = ws_UserFileList

    ReDim X(1 To objFolder.Files.Count, 1 To 2)

    For Each objFile In objFolder.Files
        lngCnt = lngCnt + 1
        X(lngCnt, 1) = Format(objFile.DateLastModified, "yyyymmdd")
        X(lngCnt, 2) = objFile.Path
       
    Next

    [A1].Resize(UBound(X, 1), 2).Value2 = X
    
    Dim LastRow     As Long
    Dim LastCol     As Integer
    '
    LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    Cells.Select
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=Range("A1" & LastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveSheet.Sort
            .SetRange Range("A1:B" & LastRow)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
   Application.ScreenUpdating = True
'-- By copy/paste the range, it will kill the query.
   Range("A1:B" & LastRow).Copy
   With Range("A1")
     .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     .Application.CutCopyMode = False
    End With
    'Just in case also run:
   Call DeleteConnectionQuery_tm
   Range("A1").Select
End Sub