Sub txttoexcel()
    With ThisWorkbook
        ChDir ThisWorkbook.Path
        filetoopen = Application.GetOpenFilename("文本文件(*.txt),*.txt", , "请选择要导入的文本文件", , True)
        If IsArray(filetoopen) Then
            For Each cc In filetoopen
                j = Application.WorksheetFunction.CountA(ActiveSheet.Range("a:a"))
                ActiveSheet.Range("a" & j + 1).Select
                With ActiveSheet.QueryTables.Add(Connection:= _
                    "TEXT;" + cc, Destination:=Range("$A$" & j + 1))
                    '.Name = "1"
                    .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 = False
                    .TextFileSemicolonDelimiter = False
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = True
                    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
            Next cc
        End If
        End With
End Sub