Excel VBA:如何将多个文本文件读入Excel工作表

时间:2018-12-20 09:35:19

标签: excel vba

我试图用一个按钮打开一个文件夹,选择一些文本文件,然后将所有文件读入我当前的工作簿中。我的工作簿中已经有一些工作表,应该在工作表的末尾打开新文件。我找到了一个可以读取的代码,但是它打开了一个新的工作簿,并且没有将其写入当前的项目中。 有人可以帮帮我吗? 这是我找到的代码,例如:

Sub fileop()
    Dim xFilesToOpen As Variant
    Dim i As Integer

    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String

    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Error", , True)


    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Error"
        GoTo ExitHandler
    End If

    i = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(i))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    xWb.Worksheets(i).Columns("A:A").TextToColumns _
    Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=False, _
    Other:=True, OtherChar:="|"

   Do While i < UBound(xFilesToOpen)
       i = i + 1
       Set xTempWb = Workbooks.Open(xFilesToOpen(i))
       With xWb
          xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
          .Worksheets(i).Columns("A:A").TextToColumns _
          Destination:=Range("A1"), DataType:=xlDelimited, _
          TextQualifier:=xlDoubleQuote, _
          ConsecutiveDelimiter:=False, _
          Tab:=False, Semicolon:=False, _
          Comma:=False, Space:=False, _
          Other:=True, OtherChar:=xDelimiter
    End With
Loop

ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Error"
    Resume ExitHandler


End Sub

2 个答案:

答案 0 :(得分:0)

你在这里。

Sub TxtImporter()
Dim f As String, flPath As String
Dim i As Long, j As Long
Dim ws As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
flPath = ThisWorkbook.Path & Application.PathSeparator
i = ThisWorkbook.Worksheets.Count
j = Application.Workbooks.Count
f = Dir(flPath & "*.txt")
Do Until f = ""
    Workbooks.OpenText flPath & f, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
        Space:=False, Other:=False, TrailingMinusNumbers:=True
    Workbooks(j + 1).Worksheets(1).Copy After:=ThisWorkbook.Worksheets(i)
    ThisWorkbook.Worksheets(i + 1).Name = Left(f, Len(f) - 4)
    Workbooks(j + 1).Close SaveChanges:=False
    i = i + 1
    f = Dir
Loop
Application.DisplayAlerts = True
End Sub

答案 1 :(得分:-1)

您打开一个新的Worksbook来插入文件。 您只需要打开一个文本文件并将其插入最后一个单元格即可。

您将在https://www.excelcampus.com/vba/find-last-row-column-cell处找到确定最后一个单元格的示例。

打开文本文件,您将在reading entire text file using vba上找到