Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Macro that runs a Macro that opens files and save them as value - Runtime Error 1004

I keep getting this 1004 runtime error. I have slimmed my programing down some so it’s not so Programception. I think it may have to do with using Excel 2010 to save .xls files. Not sure.

  1. When Auto_Root.xls opens it runs Sub auto_open() which opens Panel.xls
  2. Panel opens and runs Sub Update() which sequentially opens 7 files in different directories all called Auto_Update.xls
  3. Auto_Update.xsl opens and runs Sub Flat which each open a number of files sequentially and saves a flat copy of themselves in another directory.

I have opened each of the 7 Auto_Update.xls files and have run them independently and they run with no errors. When I run them all from Auto_Root I get a runtime error 1004. And CurrentWB.Save is highlighted on one of the files. I even replaced CurrentWB.Save as CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=xlNormal and recieved the same runtime error.

Attached is the code I have.

AutoRoot.xls!Auto Update

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!Update

 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

What I have done so far.

  1. Each Individual AutoUpdate file works when ran on its on.
  2. If Application.Run"Auto_Update.xls!Flat" is removed from Panel.xls!Update it opens and closes all of the AutoUpdate.xls files with no error.
  3. If I link Panel.xls!Update to only 3 of the 7 AutoUpdate files.... any 3. It runs with no errors.

I just can't seem to get it to run all 7 without saying Runtime Error 1004.

I found a microsoft work around code. Not sure how to implement it though.

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

like image 735
Michael Downey Avatar asked Dec 05 '14 19:12

Michael Downey


1 Answers

Based on the document from Microsoft linked below this is a known issue.

Copying worksheet programmatically causes run-time error 1004 in Excel

I'm not sure how many sheets this loop in Flat but it appears that is the issue. Specifically the quote:

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

Due to the levels that you have created using separate workbooks I would suggest starting with limiting the scope of your Update subroutine. There are many designs for something like that but I might start with passing an integer argument back and fourth between Auto Open and Update. That way you can close and reopen Panel.xls multiple times and start exactly where you left off.

like image 148
Dave Excel Avatar answered Nov 03 '22 01:11

Dave Excel