Question

我确信这是一个非常简单的方法，但我不知道这样做，但我不知道哪个。我试图将.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

Answer 1

也许这可以帮助

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

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

1 个答案: