VBA - Text File Importer Always Brings Through the First File in the Directory

[ghost5]

Hi,

I've got the code below which I have found on the internet (and modified) to bring in a text file into excel and paste it correctly.
The code works well but regardless of which text file I select, it will always import the first text file that it finds in the directory.
I think I know where the problem is but I have no idea of how to modify it.

I think it has to do with the lines

    '// Extension
    sExtension = Dir("*.txt")

and

            "TEXT;" & sExtension, Destination:=Range("$A$" & nRow))
            .Name = sExtension

My code is below, if someone could help me change it so it only imports the text file that is selected, I would be very grateful

Many thanks,

Sub Import_Test()

    '// Declare a variable as
    Dim nRow            As Long
    Dim sExtension      As String
    Dim oFolder         As FileDialog '// FileDialog object
    Dim vSelectedItem   As Variant

    '// Stop Screen Flickering
    Application.ScreenUpdating = False


  With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Title = "Select a file"
    .InitialFileName = Environ("USERPROFILE") & "\Desktop\_MACRO EXPORTS\Track Overlaps\03 Text Overlaps\"
    .Filters.Clear
    .Filters.Add "Text files", "*.txt"
    '.Filters.Add "All files", "*.*"
    If .Show = -1 Then

    '// Extension
    sExtension = Dir("*.txt")

    '// Step through each SelectedItems
 '   For Each vSelectedItem In .SelectedItems

        '// Sets Row Number for Data to Begin


        nRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

        '// Below is importing a text file
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & sExtension, Destination:=Range("$A$" & nRow))
            .Name = sExtension
            .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 = True
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = True
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = True
            .TextFileOtherDelimiter = "="
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        sExtension = Dir
'    Next
            '// If Cancel...
            Else
            End If
    End With

    Application.ScreenUpdating = True

    '// Set object to Nothing. Object? see Link Object
    Set oFolder = Nothing


End Sub

 

[HaHoBe]

Hi ghost5,

    sExtension = Dir("*.txt")

indeed will bring up the first file matching criteria, try

    '// Extension
    sExtension = .SelectedItems(1)

And you should comment the codeline

        sExtension = Dir

as you have disabled the loop.

Ciao,
Holger

 

[ghost5]

Hi ghost5,

    sExtension = Dir("*.txt")

indeed will bring up the first file matching criteria, try

    '// Extension
    sExtension = .SelectedItems(1)

And you should comment the codeline

        sExtension = Dir

as you have disabled the loop.

Ciao,
Holger

This is perfect. Thank you.

It will save me from creating multiple folders for multiple text files - I should have asked for a solution 2 years ago!