如何使用VBA批量导入txt文件到一共工作簿中,且每个txt文件的数据都在不同的sheet里工作表名字用txt文件名

Question

如何使用VBA批量导入txt文件到一共工作簿中,且每个txt文件的数据都在不同的sheet里工作表名字用txt文件名命名。
有个小需求 让我选择txt文件所在文件夹 选好文件夹打开后可以让我选择该文件夹中全部或者部分需要的文件合并。

希望能够得到您的帮助 谢谢！

Answer 1

Sub Import_Txt()
On Error Resume Next
Dim myPath, myTxt As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
myPath = .SelectedItems(1)
End With

myTxt = Dir(myPath & "\" & "*.txt")

Do While Len(myTxt) <> 0
Worksheets.Add
ActiveSheet.Name = Left(myTxt, Len(myTxt) - 4)

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & myPath & "\" & myTxt, Destination:=Range("$A$1"))
        .CommandType = 0
        .Name = Left(myTxt, Len(myTxt) - 4)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

myTxt = Dir
Loop

End Sub追问

您好 虽然可以合并 不过选择到文件夹再点进去希望可以看到txt文件 这样我还可以去掉一些不想合并的 希望再修订一下

已解决 谢谢您的帮助

来自：求助得到的回答