运行macros打开文件并将其保存为值的macros – 运行时错误1004

我一直得到这个1004运行时错误。 我已经减less了一些编程,所以不是那么节目。 我想这可能与使用Excel 2010来保存.xls文件有关。 不确定。

  1. Auto_Root.xls打开时,运行Sub auto_open(),打开Panel.xls
  2. 面板打开并运行Sub Update(),它依次在不同的目录中打开7个文件,全部名为Auto_Update.xls
  3. Auto_Update.xsl打开并运行Sub Flat,每个打开一系列文件,并将自己的平面副本保存到另一个目录中。

我打开了7个Auto_Update.xls文件中的每一个,并独立运行它们,并且没有错误地运行。 当我从Auto_Root运行它们时,我得到一个运行时错误1004.并且CurrentWB.Save在其中一个文件上突出显示。 我什至取代CurrentWB.Save CurrentWB.SaveAs文件名:= 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!平

 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. 如果Application.Run“Auto_Update.xls!Flat”从Panel.xls中删除!更新它打开并closures所有的AutoUpdate.xls文件没有错误。
  3. 如果我将Panel.xls!Update链接到7个自动更新文件中的3个….任意3.它运行时没有错误。

我似乎无法得到它运行所有7没有说运行时错误1004。

我发现了一个围绕代码的微软工作。 不知道如何实现它。

 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

基于微软下面链接的文件,这是一个已知的问题。

以编程方式复制工作表导致Excel中的运行时错误1004

我不知道这个循环在Flat中有多less张,但似乎是这个问题。 具体的报价:

当您给工作簿一个定义的名称,然后多次复制工作表而不首先保存并closures工作簿时,可能会发生此问题

由于您使用单独的工作簿创build的级别,我build议从限制您的更新子程序的范围开始。 有很多类似的devise,但我可能会开始在自动打开和更新之间传递一个整数参数。 这样,您可以多次closures并重新打开Panel.xls,并从中断位置开始。

它不是从你的文本中清楚的,而是你正在打开的文件中的“平”的程序,如果是的话,是由自动打开的macros调用? 这听起来像只想从原始工作簿中运行macros,而不是在打开的工作簿的自动打开macros中触发macros。 如果确实如此,我在其中一个工作簿中做类似的工作,在工作簿打开的时候我有一个“升级”向导,但是由于我正在升级,我打开的另一个工作簿也有升级向导,所以用来开火。 我通过在一个隐藏的Excel实例中打开另一个工作簿来解决这个问题,在我的自动打开macros中,我有一行代码查询工作簿的可见状态,并且如果它隐藏,则不会触发。 所以在下面的代码中,它的“And Me.Application.visible”控制着向导是否运行

  'Check if the ODS code is populated or default xxx, if so invoke the upgrade wizard 'but only if the application is visible If (ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value = "xxx" _ Or Len(ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value) = 0) _ And Me.Application.visible = True Then 'run the upgrade wizard frmCSCWizardv8.Show End If 

这要求您在单独的Excel实例中打开工作簿。 下面的代码是这样做的代码片段,希望这是你能够得到的想法

  Dim lRet Dim i As Integer, j As Integer Dim FoundSheet As Boolean 'Because the wizard opens the old DCS in a hidden instance of Excel, it is vital that we close this if 'anything goes wrong, so belt and braces, close it every time the user presses the button 'Switch off the error handling and the display alerts to avoid any error messages if the old dcs has 'never been opened and the hidden instance does not exist Application.DisplayAlerts = False On Error Resume Next book.Close SaveChanges:=False app.Quit Set app = Nothing Application.DisplayAlerts = True 'set error handling On Error GoTo Err_Clr 'populate the status bar Application.StatusBar = "Attempting to open File" 'Default method Uses Excel Open Dialog To Show the Files lRet = Application.GetOpenFilename("Excel files (*.xls;*.xlsx;*.xlsm;*.xlsb), *.xls;*.xlsx;*.xlsm;*.xlsb") 'If the user selects cancel update the status to tell them If lRet = False Then Me.lstOpenDCSStatus.AddItem "No file selected" 'if the user has selected a file try to open it Else 'This next section of code creates a new instance of excel to open the selected file with, as this allows us to 'open it in the background OldDCS = lRet Application.StatusBar = "Attempting to open File - " & lRet app.visible = False 'Visible is False by default, so this isn't necessary, but makes readability better Set book = app.Workbooks.Add(lRet) Application.StatusBar = "Opened File - " & lRet