vba - 运行打开文件并将其另存为值的宏的宏 - 运行时错误 1004

Question

我不断收到此 1004 运行时错误。我已经精简了一些程序，所以它不是那么程序化。我认为这可能与使用 Excel 2010 保存 .xls 文件有关。没有把握。

1. 当 Auto_Root.xls 打开时，它会运行 Sub auto_open() 来打开 面板.xls
2. 面板打开并运行 Sub Update()，依次打开 7 个文件 在不同的目录中都称为 Auto_Update.xls
3. Auto_Update.xsl 打开并运行 Sub Flat，每个 Sub Flat 打开多个 按顺序文件并将其自身的平面副本保存在另一个文件中 目录。

我已打开 7 个 Auto_Update.xls 文件中的每一个并独立运行它们，并且它们运行时没有错误。当我从 Auto_Root 运行它们时，我收到运行时错误 1004。并且 CurrentWB.Save 在其中一个文件上突出显示。我什至将 CurrentWB.Save 替换为 CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=xlNormal 并收到相同的运行时错误。

附件是我的代码。

AutoRoot.xls!自动更新

Sub auto_open()
Application.CutCopyMode = False
Dim PanelFilePath As String
Dim PanelFileName As String
Dim PanelLocation As String
Dim PanelWB As Workbook
    PanelFilePath = "D:\umc\UMC Production Files\Automation Files\"
    PanelFileName = "Panel.xls"
    PanelLocation = PanelFilePath & Dir$(PanelFilePath & PanelFileName)
        Set PanelWB = Workbooks.Open(Filename:=PanelLocation, UpdateLinks:=3)
            PanelWB.RunAutoMacros Which:=xlAutoOpen
            Application.Run "Panel.xls!Update"
            PanelWB.Close
    Call Shell("D:\umc\UMC Production Files\Automation Files\Auto.bat", vbNormalFocus)
Application.Quit
End Sub

Panel.xls!更新

 Sub Update()
Dim RowNumber As Long
Dim AutoUpdateTargetFile As String
Dim AutoUpdateWB As Workbook
For RowNumber = 1 To (Range("AutoUpdate.File").Rows.Count - 1)
    If (Range("AutoUpdate.File").Rows(RowNumber) <> "") Then
        AutoUpdateTargetFile = Range("Sys.Path") & Range("Client.Path").Rows(RowNumber) & Range("AutoUpdate.Path ").Rows(RowNumber) & Range("AutoUpdate.File").Rows(RowNumber)
        Set AutoUpdateWB = Workbooks.Open(Filename:=AutoUpdateTargetFile, UpdateLinks:=3)
            AutoUpdateWB.RunAutoMacros Which:=xlAutoOpen
            Application.Run "Auto_Update.xls!Flat"
            AutoUpdateWB.Close
    End If
    Next RowNumber
End Sub

AutoUpdate.xls!Flat

Sub Flat()
Dim RowNumber As Long 'Long Stores Variable
Dim SheetNumber As Long
Dim TargetFile As String 'String Stores File Path
Dim BackupFile As String
Dim CurrentWB As Workbook 'Workbook Stores Workbook
For RowNumber = 1 To (Range("File").Rows.Count - 1)
'Loops through each file in the list and assigns a workbook variable.
    If (Range("File").Rows(RowNumber) <> "") Then
        TargetFile = Range("Sys.Path") & Range("Path").Rows(RowNumber) & Range("File").Rows(RowNumber) 'Target File Path
        BackupFile = Range("Report.Path") & Range("Path").Rows(RowNumber) & Range("SubFolder") & Range("File").Rows(RowNumber) 'Backup File Path
Set CurrentWB = Workbooks.Open(Filename:=TargetFile, UpdateLinks:=3) 'Sets CurrentWB = to that long name. This becomes the name of the workbook.
    CurrentWB.RunAutoMacros Which:=xlAutoOpen 'Enables Macros in Workbook
    CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=56
        For SheetNumber = 1 To Sheets.Count 'Counts Worksheets in Workbook
            Sheets(SheetNumber).Select 'Selects All Worksheets in Workbook
            If (Sheets(SheetNumber).Name <> "What If") Then
                Sheets(SheetNumber).Unprotect ("UMC626") 'Unprotects Workbook
                Cells.Select 'Selects Data in Workbook
                Range("B2").Activate
                With Sheets(SheetNumber).UsedRange
                    .Value = .Value
                End With
                Sheets(SheetNumber).Protect Password:="UMC626", DrawingObjects:=True, Contents:=True, Scenarios:=True 'Protects Workbook
            End If
        Next SheetNumber 'Runs Through Iteration
        Sheets(1).Select
        Range("A1").Select 'Saves each workbook at the top of the page
        CurrentWB.SaveAs Filename:=BackupFile, FileFormat:=56, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False 'Saves Workbook in Flatten File Location
    CurrentWB.Close 'Closes Workbook
    End If 'Ends Loop
Next RowNumber 'Selects Another Account
End Sub

到目前为止我做了什么。

1. 每个单独的自动更新文件在其上运行时都可以工作。
2. 如果从 Panel.xls!Update 中删除 Application.Run"Auto_Update.xls!Flat"，它将打开和关闭所有 AutoUpdate.xls 文件，不会出现错误。
3. 如果我将 Panel.xls!Update 仅链接到 7 个自动更新文件中的 3 个......任意 3 个。它运行时没有错误。

如果不说运行时错误 1004，我似乎无法让它运行所有 7 个。

我找到了一个微软解决代码。但不确定如何实现。

Sub CopySheetTest()
    Dim iTemp As Integer
    Dim oBook As Workbook
    Dim iCounter As Integer

    ' Create a new blank workbook:
    iTemp = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set oBook = Application.Workbooks.Add
    Application.SheetsInNewWorkbook = iTemp

    ' Add a defined name to the workbook
    ' that RefersTo a range:
    oBook.Names.Add Name:="tempRange", _
        RefersTo:="=Sheet1!$A$1"

    ' Save the workbook:
    oBook.SaveAs "c:\test2.xls"

    ' Copy the sheet in a loop. Eventually,
    ' you get error 1004: Copy Method of
    ' Worksheet class failed.
    For iCounter = 1 To 275
        oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
        'Uncomment this code for the workaround:
        'Save, close, and reopen after every 100 iterations:
        If iCounter Mod 100 = 0 Then
            oBook.Close SaveChanges:=True
            Set oBook = Nothing
            Set oBook = Application.Workbooks.Open("c:\test2.xls")
        End If
    Next
End Sub

http://support.microsoft.com/kb/210684/en-us

Answer 1

根据下面链接的 Microsoft 文档，这是一个已知问题。

Copying worksheet programmatically causes run-time error 1004 in Excel

我不确定这个 Flat 循环有多少张纸，但这似乎就是问题所在。具体引用如下:

This problem can occur when you give the workbook a defined name and then copy the worksheet several times without first saving and closing the workbook

由于您使用单独的工作簿创建的级别，我建议您首先限制更新子例程的范围。类似的设计有很多，但我可能会从在自动打开和更新之间传递一个整数参数开始。这样您就可以多次关闭并重新打开 Panel.xls，并从上次中断的地方开始。