Excel VBA:将数据导入工作簿中的新工作表

我肯定有一个非常简单的方法我没有实现这一点，但我不知道是哪个。我正在尝试将.txt格式的数据文件导入当前工作簿中的新工作表。差不多了，但我正在打开一个新工作簿，而不是当前工作簿中的新工作表。理想情况下，我也会同时选择几个文件，但如果一次也能选择一个文件，我会很高兴。帮助谢谢

Sub ImportData()

Dim vFileName

On Error GoTo ErrorHandle

vFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt")

If vFileName = False Or Right(vFileName, 3) <> "txt" Then
    GoTo BeforeExit
End If

ActiveWorkbook.Sheets.Add

Workbooks.OpenText Filename:=vFileName, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="|", TrailingMinusNumbers:=True, _
Local:=True

BeforeExit:
Worksheets("Intro").Activate
Exit Sub

ErrorHandle:
MsgBox Err.Description
Resume BeforeExit

End Sub

也许这会有帮助

Sub ImportData()

Dim vFileName As Variant
Dim i As Byte 'if you are goint to select more than 254 files, change this to Integer or whatever you need


vFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)


On Error GoTo ErrorHandle
If IsError(vFileName) = True Or Right(vFileName, 3) <> "txt" Then
    GoTo BeforeExit
End If

GotFiles:
For i = 1 To UBound(vFileName) Step 1
    'maybe you will need to modify the code below to adapt it to your exportation needs
    ThisWorkbook.Sheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & vFileName(i), Destination:=Range( _
        "$A$1"))
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Next i

Exit Sub

BeforeExit:
Worksheets("Intro").Activate
Exit Sub

ErrorHandle:
If Err.Number = 13 Then GoTo GotFiles
MsgBox Err.Description
Resume BeforeExit

End Sub