Vb.net 在VBA复制错误中复制工作表

嗨，我在VB中将工作表从一个工作簿复制到另一个工作簿时遇到问题。我所拥有的代码在全新的工作簿中运行良好，但过了一段时间，它就崩溃了，并给出了以下错误：对象“\u工作表”的“复制”方法失败。很多人建议保存工作簿，并在复制时重新打开它。我试过了，但还是不起作用。我还检查了这个名字是否真的变长了。在复制工作表之前，我将工作表的名称设置为计数器，但仍然存在错误。我真的很困惑，希望有人能想出解决办法。此外，两个工作簿中只有3个工作表

'Copies all the worksheets from one workbook to another workbook
'source_name is the Workbook's FullName
'dest_name is the Workbook's FullName
Function copyWorkbookToWorkbook(source_name As String, dest_name As String) As Boolean
    Dim dest_wb As Workbook
    Dim source_wb As Workbook
    Dim dest_app As New Excel.Application
    Dim source_app As New Excel.Application
    Dim source_ws As Worksheets
    Dim counter As Integer
    Dim num_ws As Integer
    Dim new_source As Boolean
    Dim new_dest As Boolean
    Dim ws As Worksheet
    Dim regex As String

    Application.ScreenUpdating = False

    If source_name = "" Or dest_name = "" Then
        MsgBox "Source and Target must both be selected!", vbCritical
        copyWorkbookToWorkbook = False
    ElseIf GetAttr(dest_name) = vbReadOnly Then
        MsgBox "The target file is readonly and cannot be modified", vbCritical
        copyWorkbookToWorkbook = False
    Else
        regex = "[^\\]*\.[^\\]*$"   'Gets only the filename
        copyWorkbookToWorkbook = True

        If (isWorkbookOpen(source_name)) Then
            Set source_wb = Workbooks(regExp(source_name, regex, False, True)(0).Value)
        Else
            Set source_wb = source_app.Workbooks.Open(source_name)
            new_source = True
        End If

        If (isWorkbookOpen(dest_name)) Then
            Set dest_wb = Workbooks(regExp(dest_name, regex, False, True)(0).Value)
        Else
            Set dest_wb = dest_app.Workbooks.Open(dest_name)
            new_dest = True
        End If

        'Clean the workbooks before copying the data
        'Call cleanWorkbook(source_wb)
        'Call cleanWorkbook(dest_wb)

        'Copy each worksheet from source to target

        counter = 0
        source_wb.Activate
        For Each ws In source_wb.Worksheets
            MsgBox dest_wb.Worksheets.Count
            ws.Copy After:=dest_wb.Worksheets(dest_wb.Worksheets.Count)
            counter = counter + 1
        Next ws

        'Save and close any newly opened files
        If (new_dest) Then
            dest_wb.Application.DisplayAlerts = False
            dest_wb.SaveAs Filename:=dest_name, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
            dest_wb.Application.CutCopyMode = False
            dest_wb.Close
        End If
        If (new_source) Then
            source_wb.Application.DisplayAlerts = False
            source_wb.SaveAs Filename:=source_name, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
            source_wb.Close
        End If

        MsgBox counter & " worksheets have been cleaned and copied.", vbInformation + vbOKOnly

    End If

    'Cleanup
    Set dest_wb = Nothing
    Set source_wb = Nothing
    Set dest_app = Nothing
    Set source_app = Nothing
    Set source_ws = Nothing
    Set ws = Nothing
End Function

Function regExp(str As String, pattern As String, ignore_case As Boolean, glo As Boolean) As MatchCollection
    Dim regex As New VBScript_RegExp_55.regExp
    Dim matches As MatchCollection

    regex.pattern = pattern
    regex.IgnoreCase = ignore_case
    regex.Global = glo

    Set regExp = regex.Execute(str)
End Function

---

编辑：我所说的“此工作簿在一段时间后会中断”的意思是，我可以在其上多次运行此代码（可能大约30次）。最终，即使我删除了dest\u wb中的工作表，这个错误也会出现“对象的方法‘复制’失败”。它指向复制行。

是的，在我使用的一些代码中，我遇到了完全相同的问题，尽管它从来没有足够的压力让我去做（显然）我需要做的事情来修复它

知识库文章中描述了这个问题。文章建议：

要解决此问题，请定期保存并关闭工作簿 复制过程正在进行时

我注意到您说过“在复制时保存并重新打开工作簿”，但我假设您在运行代码之前就这样做了，因为我看不到任何在循环过程中执行的指示。在循环内部执行此操作的一种方法是：

通过使用

On Error Goto

在手术过程的早期行；然后

放置

Exit Function
ErrorHandler:

在底部挡块。在错误处理程序内部，您需要检查Err.Number是否为1004。如果是，请同时关闭源工作簿和目标工作簿，然后重新打开这两个工作簿，并在发生错误的行继续。跟踪对错误处理程序的调用次数是一个好主意，只需在一定次数后放弃，以确保不会陷入无限循环

这基本上是我解决问题的想法，但我从来没有时间/迫切需要实施它。在发布之前我已经测试过了，但是文件在办公室里，我目前没有访问权限

如果你决定走这条路，我很想看看你会怎么走

---

另一个选项是KB文章中建议的，即在n次迭代后关闭并重新打开该书。问题是它建议100次迭代，而我的迭代在32次或33次之后失败。（这似乎取决于工作表的大小，除其他外。）还有一些情况下，我的工作表在10次之后失败（使用完全相同的工作表），唯一的解决方法是关闭并重新打开Excel。（显然，基于VBA的代码没有太多选项。）

我在从“模板”文件复制工作表时遇到过类似的问题。我认为这是一个内存问题，在进行了一定数量的复制和粘贴（取决于您的系统）后会出现这个问题

根据您的工作表包含的内容，有一些变通方法。我不需要循环阅读许多工作簿，但我发现以下函数可以有效地完成相同的工作，而且没有任何问题

不过，需要注意的是，每次将工作表从一个工作簿复制到另一个工作簿时，您都会创建两个新的Excel实例，这可能对您没有帮助。为什么不能使用Excel实例？请至少使用一个Excel实例

Sub CopyWorksheet(wsSource As Worksheet, sName As String, wsLocation As Worksheet, sLocation As String)
    'Instead of straight copying we just add a temp worksheet and copy the cells.
    Dim wsTemp As Worksheet

    'The sLocation could be a boolean for before/after. whatever.
    If sLocation = "After" Then
        Set wsTemp = wsLocation.Parent.Worksheets.Add(, wsLocation)
    ElseIf sLocation = "Before" Then
        Set wsTemp = wsLocation.Parent.Worksheets.Add(wsLocation)
    End If

    'After the new worksheet is created
    With wsTemp
        .Name = sName                           'Name it
        .Activate                               'Bring it to foreground for pasting
        wsSource.Cells.Copy                     'Copy all the cells in the original
        .Paste                                  'Paste all the cells
        .Cells(1, 1).Select                     'Select the first cell so the whole sheet isn't selected
    End With
    Application.CutCopyMode = False
End Sub

---

您是否正在初始化dest_wb？是的，它始终处于初始化状态。请粘贴所有相关代码。当我初始化两个工作簿时，您的代码对我有效。床单是否受到保护？另外，您对它什么时候不起作用的描述也没有真正的帮助-

一段时间后，它会中断并给我这个错误

您是什么意思？我所说的“此工作簿在一段时间后中断”的意思是，我可以在它上运行此代码多次（可能大约30次）。最终，即使我删除了dest\u wb中的工作表，这个错误也会出现“对象的方法‘复制’失败”。它指向复制行。我最初让它在循环中保存、关闭和打开。我把它拿出来是因为它坏了。（这就是为什么它不在我的代码中：P）我想我应该留下来对它进行注释，这样就不会让每个人都感到困惑。我将尝试错误转到，但我有一种感觉，它不会有帮助，因为它几乎是相同的结果，把它放在循环中。更清楚一点，它在第一次运行Copy语句时就导致了这个错误。第一次运行时，我在那里放了一条调试语句（最后在我发布的代码中删除了它）？嗯，很有意思，这对我来说是新的。如果您继续尝试打开/关闭例程，那么您可能想尝试的另一件事（我注意到这是在MSKB代码中）是将所有引用设置为Nothing，然后重新创建它们。Hm也尝试了，但似乎不起作用。我希望我可以上传我在这里使用的文件，这样我们就可以得到相同的结果。谢谢你，这解决了我的问题。每当我打开这两个excel实例时，总是会出现错误1004。