从文本文件导入到Excel

Question

I am trying to write a VBA macro that will prompt the user to choose a directory immediately after running it.

Once the user chooses a directory, the macro will scan through all the *.txt files in it and put each of its contents in new row under column G . So, the contents of 1st text file will be in G2 , second text file in G3 and so on.

I browsed StackOverFlow for long and found a working code

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

I also did some very poor hard-coding to import just one text file into cell G2

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\K\record001_001.txt" _
        , Destination:=Range("$G$2"))
        .Name = "record001_001"
        .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
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

I do not know how to put these pieces together to have a working code that will.

1. Read all the txt files inside the directory I choose.
2. Put each of the text files content in a new row of the same worksheet ( G2 , G3 , etc.)

Each of those text files have just one or two rows of data and do not want anything to be delimited there. Just copy the whole lot of text in the txt file and paste it in G2 , in a loop until all txt files in the selected directory are done.

Answer 1

1. To Read all the txt files inside the directory or to choose one file

The following code should let you choose one or multiple files you want to Import

Application.FileDialog Property (Excel)

    '// Open Dailog
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True <-- Allow multiple selection
        .Show '<-- display the files
    End With

2. To set Row Number for Data to Begin at G2 then next

If need update the following code

nRow = Range("G2").End(xlUp).Offset(1, 0).row    
Destination:=Range("$G$" & nRow))  

See complete CODE with comments

Sub Import()
    '// 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

    '// Create a FileDialog object as a File Picker dialog box
    Set oFolder = Application.FileDialog(msoFileDialogOpen)

    '// Use a With...End With block to reference FileDialog.
    With oFolder
        '// Allow multiple selection.
        .AllowMultiSelect = True
        '// Use the Show method to display the 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 = Range("G2").End(xlUp).Offset(1, 0).row

        '// Below is importing a text file
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & sExtension, Destination:=Range("$G$" & 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

Set Object = Nothing