Vba Indsæt navn på tekstfil

Hej

Jeg har sakset en glimrende Vba kode fra nettet. Fra et excelark kan den gå ind i en mappe og åbne og indsætte samtlige tekstfiler der måtte ligge der, i hvert sit ark.
Der er dog den mangel at den ikke viser hvad filen hedder. Så opgaven går ud på at lave en tilføjelse til nedenstående kode, således at der bliver indsat navnet på filen i A1:

Sub LoadPipeDelimitedFiles()
    Dim idx As Integer
    Dim fpath As String
    Dim fname As String

    idx = 0
    fpath = "C:\Users\TUFexcel\Desktop\Txtfiler\"
    fname = Dir(fpath & "*.txt")
    While (Len(fname) > 0)
        idx = idx + 1
        Sheets("Sheet" & idx).Select
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
          & fpath & fname, Destination:=Range("A3"))
            .Name = "a" & idx
           
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(3, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
     
   
   
      fname = Dir
        End With
   
    Wend
   
End Sub