從文本文件導入到Excel

Question

我正在嘗試編寫一個VBA宏，該宏將提示用戶在運行目錄后立即選擇目錄。

用戶選擇目錄后，宏將掃描其中的所有*.txt文件，並將其所有內容放在G列下的新行中。 因此，第一個文本文件的內容將在G2 ，第二個文本文件在G3 ，依此類推。

我瀏覽了StackOverFlow很長時間，發現了一個有效的代碼

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

我還做了一些非常差勁的硬編碼，僅將一個文本文件導入到單元格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

我不知道如何將這些部分放在一起以形成可以正常工作的代碼。

1. 閱讀我選擇的目錄內的所有txt文件。
2. 將每個文本文件內容放在同一工作表的新行中（ G2 ， G3等）

這些文本文件中的每一個僅具有一兩行數據，並且不希望在此處分隔任何內容。 只需將整個文本復制到txt文件中，然后循環粘貼到G2 ，直到完成所選目錄中的所有txt文件即可。

Answer 1

1. 讀取目錄中的所有txt文件或選擇一個文件

以下代碼應讓您選擇一個或多個要導入的文件

Application.FileDialog屬性（Excel）

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

2. 設置數據的行號從G2開始，然后下一步

如果需要更新以下代碼

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

查看完整的CODE（帶注釋）

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

設置對象=空