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

我不知道如何把这些碎片放在一起，以便有一个可行的代码。

阅读我选择的目录中的所有txt个文件。
将每个文本文件内容放在同一工作表的新行中（G2，G3等。）

每个文本文件只有一行或两行数据，不希望在那里分隔任何内容。只需复制txt文件中的大量文本，然后将其粘贴到G2中，循环播放，直到所选目录中的所有txt个文件都完成为止。

Answer 1

读取目录中的所有txt文件或选择一个文件

以下代码可让您选择一个或多个要导入的文件

Application.FileDialog Property (Excel)

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

将数据的行号设置为从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

Set Object = Nothing

从文本文件导入Excel

1 个答案: