Question

我有一个excel文件（2013）（例如 test.xlsm ）。 excel文件包含带有图表和数据透视表的工作表，每月刷新一次，基于文本文件。我需要一个VBA代码，它可以从我的本地驱动器（我从服务器导入）导入多个文本文件，并将它们附加到此excel文件中的末尾（名称类似于文本文件名的工作表）。每个月，当我导入文本文件时，它必须用新文件替换此数据表。

问题：
我在link找到了一个VBA代码！它工作得很好。但我的问题是它将数据导入新打开的工作簿而不是现有的工作簿。

解决方案

我修改了

中的行

Set wkbAll = ActiveWorkbook
wkbTemp.Sheets(1).Copy

到

Set wkbAll = ThisWorkbook
wkbAll.Activate
wkbTemp.Sheets(1).Copy After:=Sheets(wkbAll.Sheets.Count)

但是我得到错误1004，没有选择数据来使用分隔符格式化数据

wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
    Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=False, _
    Other:=True, OtherChar:="|"

解决方案 我发现了一些与我类似的问题（如this one），但它们都没有为我工作。

请帮我解决这个问题。

这是我的代码更改

Sub copydata()

    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim sDelimiter As String


    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

    FilesToOpen = Application.GetOpenFilename _
        (FileFilter:="Text Files (*.txt), *.txt", _
        MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If


    Set wkbAll = Application.ActiveWorkbook
    x = 1

    With Workbooks.Open(fileName:=FilesToOpen(x))
        .Worksheets(1).Columns("A:A").TextToColumns _
            Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
            Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
            Other:=True, OtherChar:="|"
        .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)
        .Close False
    End With

    x = x + 1

    While x <= UBound(FilesToOpen)
        With Workbooks.Open(fileName:=FilesToOpen(x))
            .Worksheets(1).Columns("A:A").TextToColumns _
                Destination:=Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, _
                Tab:=False, Semicolon:=False, _
                Comma:=False, Space:=False, _
                Other:=True, OtherChar:=sDelimiter
            .Sheets(1).Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)

        End With
        x = x + 1
    Wend

    wkbAll.Save
ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Answer 1

OP的新请求后

已修改（请参阅答案底部）

变化

C:\MongoDB\Server\3.4\bin>sc.exe delete MongoDB
[SC] DeleteService SUCCESS

C:\MongoDB\Server\3.4\bin>sc.exe create MongoDB binPath= "\"C:\MongoDB\Server\3.4\bin\mongod.exe\" --service --config=\"C:\MongoDB\Server\3.4\mongod.cfg\"" DisplayName= "MongoDB" start= "auto"
[SC] CreateService SUCCESS

C:\MongoDB\Server\3.4\bin>net start MongoDB
The MongoDB service is starting....
The MongoDB service was started successfully.

到

wkbTemp.Sheets(1).Copy After:=Sheets(wkbAll.Sheets.Count)

因此你也可以改变整个部分：

wkbTemp.Sheets(1).Copy After:=wkbAll.Sheets(wkbAll.Sheets.Count)

到

Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
Set wkbAll = ThisWorkbook
wkbAll.Activate
wkbTemp.Sheets(1).Copy After:=Sheets(wkbAll.Sheets.Count)
wkbTemp.Close (False)

并完全摆脱With Workbooks.Open(Filename:=FilesToOpen(x)) .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count) .Close False End With变量

是否需要将数据复制到同一工作簿的现有工作表中，然后替换

wkbTemp

与

With Workbooks.Open(Filename:=FilesToOpen(x))
    .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)
    .Close False
End With

导入多个文本文件以分隔现有工作簿中的工作表

1 个答案: