Macro che esegue una macro che apre i file e li salva come valore - Errore di runtime 1004

Question

Continuo a ricevere questo errore di runtime 1004. Ho ridotto la mia programmazione in qualche modo quindi non è così Programception. Penso che possa avere a che fare con l'utilizzo di Excel 2010 per salvare i file .xls. Non sono sicuro.

1. Quando Auto_Root.xls apre Corre Auto_apri Sub(), che si apre si apre Panel.xls
2. Panel e corre aggiornamento Sub(), che in sequenza si apre 7 file in diverse directory tutti chiamati Auto_Update.xls
3. Auto_Update.xsl apre ed esegue Sub Flat che aprono ciascuno un numero di file in sequenza e ne salva una copia flat in un'altra directory .

Ho aperto ciascuno dei 7 file Auto_Update.xls e li ho eseguiti indipendentemente e corrono senza errori. Quando li eseguo tutti da Auto_Root ottengo un errore di runtime 1004. E CurrentWB.Save è evidenziato su uno dei file. Ho persino sostituito CurrentWB.Save come nome file CurrentWB.SaveAs: = TargetFile, FileFormat: = xlNormal e ho ricevuto lo stesso errore di runtime.

In allegato è il codice che ho.

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

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

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 

Quello che ho fatto finora.

1. Ogni singolo file di AutoUpdate funziona quando è acceso.
2. Se Application.Run "Auto_Update.xls! Flat" viene rimosso da Panel.xls! Aggiorna apre e chiude tutti i file AutoUpdate.xls senza errori.
3. Se collego Panel.xls! Update a solo 3 dei 7 file di AutoUpdate .... any 3. Funziona senza errori.

io proprio non riesco a farlo funzionare tutto senza dire 7 Errore di runtime 1004.

ho trovato un lavoro intorno Microsoft codice. Non so come implementarlo però.

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

Sulla base del documento da Microsoft collegato di sotto di questo è un problema noto.

Copying worksheet programmatically causes run-time error 1004 in Excel

Non sono sicuro di quanti fogli questo circuito nel piatto ma sembra che è il problema. In particolare la citazione:

Questo problema può verificarsi quando si dà la cartella di lavoro un nome definito e quindi copiare il foglio di lavoro più volte senza prima salvare e chiudere la cartella di lavoro

A causa dei livelli che hai creato utilizzando cartelle di lavoro separate, suggerirei di iniziare limitando l'ambito della subroutine di aggiornamento. Ci sono molti progetti per qualcosa di simile, ma potrei iniziare passando un argomento intero indietro e il quarto tra Auto Open e Update. In questo modo puoi chiudere e riaprire Panel.xls più volte e iniziare esattamente da dove sei stato interrotto.

Answer 2

non

Il suo chiaro dal testo, ma è la vostra procedura di "Flat" all'interno dei file si sta aprendo e se così è essere chiamato dalla macro aperta di auto? Sembra che tu voglia eseguire solo la tua macro dalla cartella di lavoro originale e non sparare quelli nella macro di apertura automatica delle cartelle di lavoro che apri. Se è davvero così, io faccio qualcosa di simile in una delle mie cartelle di lavoro, dove ho un wizard "upgrade" che si attiva quando viene aperto il libro di lavoro, tuttavia perché sto aggiornando, l'altra cartella di lavoro che apro, ha anche il procedura guidata di aggiornamento e anche quella utilizzata per sparare.Ho risolto questo problema aprendo l'altra cartella di lavoro in un'istanza nascosta di Excel e all'interno della macro auto aperta ho una riga di codice che interroga lo stato visibile della cartella di lavoro e non attiva se è nascosta. Quindi, nel codice di sotto del suo la "E Me.Application.visible" che controlla se la procedura guidata viene eseguita

'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 

Ciò richiede che si apre le cartelle di lavoro in un'istanza separata eccellere. Il codice che segue è il frammento di codice che fa questo, spero che questo è enopugh per voi per ottenere l'idea

 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