Microsoft Excel

Herbers Excel/VBA-Archiv

Die Methode 'Open' für das Objekt 'Workbooks' ist

Betrifft: Die Methode 'Open' für das Objekt 'Workbooks' ist von: Christian Zumbrunnen
Geschrieben am: 07.03.2016 21:18:03

Auf den ersten Blick scheint die Fehlermeldung klar und ich vermutete, dass sich etwas geändert hat, als ein Kollege meldete, dass sein Excel-Makro nicht mehr funktioniert.

Seltsam ist allerdings, dass das Makro durchläuft und bei dutzenden von Files funktioniert und _ dann plötzlich die Fehlermeldung erscheint:

Laufzeitfehler '1004'
Die Methode 'Open' für das Objekt 'Workbooks' ist fehlgeschlagen

Ich vermutete ein Problem mit der Datei. Wenn man jedoch die Datei völlig entfernt, tritt der Fehler einfach bei einer anderen Datei auf.

Selbst wenn man die Datei, welche den Fehler verursacht, entfernt und mit einer gleichnamigen Datei ersetzt bei der das Makro zuvor durchgelaufen ist, geht es plötzlich nicht mehr.

An der Menge der Dateien kann es nicht liegen, denn die hat sich nicht geändert, als es plötzlich aufgehört hat zu funktionieren.

Hier noch der komplette Code, der wie gesagt, bisher funktioniert hat und ohne erkennbare Ursache plötzlich nicht mehr geht.

Gibt es einen Tipp oder Anhaltspunkt woran das liegen könnte?
Option Explicit
Option Compare Text
Sub zusammensetzen()
 

Dim i
Dim myfolder
Dim mytabelle
Dim myrange
Dim mylines
Dim betragzelle
Dim myfilename
Dim berechnungsdatum
 

Dim fso As Object
Dim fol As Object
Dim fil As Object
 

'Where you define what to "zusammensetzen"
myfolder = Range("D4")              'Pfad zu den Arbeitsrapporten
mytabelle = Range("D6")             'Name der zu bearbeitenden Tabelle
myrange = Range("D9")               'Bereich in der Tabelle, welcher kopiert werden soll ( _
Feldwert(e)):
mylines = Range(myrange).Rows.Count 'zum Berechnen der Zeile zum nächsten Einfügen
betragzelle = Range("D11")          'Position, bei welcher mit Einfügen begonnen werden soll
berechnungsdatum = Date             'Das aktuelle Datum, wird in der Totalzeile ausgegeben
 

i = 0
Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder(myfolder)
 

'Zuerst wird das gesamte Tabellenblatt von Inhalt und Formatierungen befreit
'ThisWorkbook.Worksheets("Auswertung").Activate
'ActiveSheet.UsedRange.Clear
 

ThisWorkbook.Worksheets("Auswertung").Cells.Clear   'scheint mir etwas schneller zu sein
 

For Each fil In fol.Files
    i = i + 1
    Workbooks.Open Filename:=fil
    myfilename = Right(fil, Len(fil) - Len(myfolder))
    Sheets(mytabelle).Activate
    Range(myrange).Copy
 

    With ThisWorkbook.Worksheets("Auswertung").Range(betragzelle).offset(rowOffset:=(i *  _
mylines - mylines), columnOffset:=1)
        .PasteSpecial Paste:=xlPasteValues
        
        
    ThisWorkbook.Worksheets("Auswertung").Range(betragzelle).offset(i * mylines - mylines). _
Value = myfilename
        With .Borders(xlEdgeTop)
             .LineStyle = xlContinuous
             .ColorIndex = 0
             .TintAndShade = 0
             .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
             .LineStyle = xlContinuous
             .ColorIndex = 0
             .TintAndShade = 0
             .Weight = xlThin
        End With
        With .Interior
             .Pattern = xlSolid
             .PatternColorIndex = xlAutomatic
             .Color = RGB(255, 213, 0)
             .TintAndShade = 0
             .PatternTintAndShade = 0
        End With
    End With
        
    ActiveWorkbook.Close False
    
Next fil
 

    i = i + 2
    With ThisWorkbook.Worksheets("Auswertung").Range(betragzelle).offset(rowOffset:=(i *  _
mylines - mylines), columnOffset:=1)
        .FormulaR1C1 = "=SUM(R[-" & i & "]C:R[-1]C)"
 

        With .Borders(xlEdgeTop)
             .LineStyle = xlContinuous
             .ColorIndex = 0
             .TintAndShade = 0
             .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
             .LineStyle = xlDouble
             .ColorIndex = 0
             .TintAndShade = 0
             .Weight = xlThick
        End With
        With .Interior
             .Pattern = xlSolid
             .PatternColorIndex = xlAutomatic
             .Color = 65535
             .TintAndShade = 0
             .PatternTintAndShade = 0
        End With
       
        With .Font
             .Size = 12
        End With
            
    End With
    ThisWorkbook.Worksheets("Auswertung").Range(betragzelle).offset(i * mylines - mylines). _
Value = "Total: (" & berechnungsdatum & ")"
End Sub

  

Betrifft: AW: Die Methode 'Open' für das Objekt 'Workbooks' ist von: fcs
Geschrieben am: 08.03.2016 08:11:44

Hallo Christian,

an dem Makro ist nichts grundsätzlich verkehrtes (es hat ja bisher auch funktioniert).

Ich hab für mich den Code etwas angepasst, damit es übersichtlicher wird.
Objektvariablen für
- das Auswerteblatt
- die jeweils geöffnete Rapportdatei

zusätzlich hab ich
- eine Prüfung auf die Erweiterung des Dateinamens eingebaut (.xls oder .xlsx)
- eine Anweisung eingefügt, die nach dem Kopieren die Zwischenablage leert
- die Bildschirmaktualisierung während der Makroausführung deaktiviert.
- Objektvariablen werden zurückgesetzt nachdem sie nicht mehr benötigt werden.

Ob das in Bezug auf den ABbruch des Makros nach einer bestimmten Anzahl Dateien etwas bringt? Ich weiß es nicht.
Nach wie vielen Dateien kommt es zum Fehler?

Gruß
Franz

Option Explicit
Option Compare Text
Sub zusammensetzen()
 

    Dim i
    Dim myfolder
    Dim mytabelle
    Dim myrange
    Dim mylines
    Dim betragzelle
    Dim myfilename
    Dim berechnungsdatum
     
    
    Dim fso As Object
    Dim fol As Object
    Dim fil As Object
    
    Dim wksAuswertung As Worksheet
    Dim wkbRap As Workbook
    
    'Where you define what to "zusammensetzen"
    myfolder = Range("D4")              'Pfad zu den Arbeitsrapporten
    mytabelle = Range("D6")             'Name der zu bearbeitenden Tabelle
    myrange = Range("D9")               'Bereich in der Tabelle, welcher kopiert werden soll (  _
_
    Feldwert(e)):
    mylines = Range(myrange).Rows.Count 'zum Berechnen der Zeile zum nächsten Einfügen
    betragzelle = Range("D11")          'Position, bei welcher mit Einfügen begonnen werden  _
soll
    berechnungsdatum = Date             'Das aktuelle Datum, wird in der Totalzeile ausgegeben
     
    
    i = 0
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fol = fso.GetFolder(myfolder)
     
    Set wksAuswertung = ThisWorkbook.Worksheets("Auswertung")
    'Zuerst wird das gesamte Tabellenblatt von Inhalt und Formatierungen befreit
    'wksAuswertung.Activate
    'ActiveSheet.UsedRange.Clear
     
    Application.ScreenUpdating = False
    
    wksAuswertung.Cells.Clear   'scheint mir etwas schneller zu sein
     
    
    For Each fil In fol.Files
        
        Select Case LCase(Mid(fil, InStrRev(fil, "."))) 'Dateierweiterung prüfen
        
        Case ".xls", ".xlsx" 'ggf.  Erweiterungen ergänzen
           i = i + 1
           Set wkbRap = Application.Workbooks.Open(Filename:=fil, ReadOnly:=True, addtomru:= _
False)
           myfilename = wkbRap.Name
           With wkbRap.Sheets(mytabelle)
               .Activate                'ist wahrscheinlich überflüssig
               .Range(myrange).Copy
           End With
        
           With wksAuswertung.Range(betragzelle).Offset(rowOffset:=(i * _
                   mylines - mylines), columnOffset:=1)
               .PasteSpecial Paste:=xlPasteValues
               
               Application.CutCopyMode = False  'räumt Zwischenablage leer
               
           wksAuswertung.Range(betragzelle).Offset(i * mylines - mylines).Value _
               = myfilename
               With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
               End With
               With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
               End With
               With .Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = RGB(255, 213, 0)
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
               End With
           End With
               
           wkbRap.Close False
           Set wkbRap = Nothing
        Case Else
            'do nothing
        End Select 'Prüfung Dateierweiterung
    Next fil
    Set fol = Nothing
    Set fso = Nothing

    i = i + 2
    With wksAuswertung.Range(betragzelle).Offset(rowOffset:=(i * _
            mylines - mylines), columnOffset:=1)
        .FormulaR1C1 = "=SUM(R[-" & i & "]C:R[-1]C)"
 

        With .Borders(xlEdgeTop)
             .LineStyle = xlContinuous
             .ColorIndex = 0
             .TintAndShade = 0
             .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
             .LineStyle = xlDouble
             .ColorIndex = 0
             .TintAndShade = 0
             .Weight = xlThick
        End With
        With .Interior
             .Pattern = xlSolid
             .PatternColorIndex = xlAutomatic
             .Color = 65535
             .TintAndShade = 0
             .PatternTintAndShade = 0
        End With
       
        With .Font
             .Size = 12
        End With
            
    End With
    wksAuswertung.Range(betragzelle).Offset(i * mylines - mylines).Value _
        = "Total: (" & berechnungsdatum & ")"

    Set wksAuswertung = Nothing
    Application.ScreenUpdating = True


End Sub



  

Betrifft: AW: Die Methode 'Open' für das Objekt 'Workbooks' ist von: Christian Zumbrunnen
Geschrieben am: 08.03.2016 13:19:23

Wow, das ist ja ein Superservice!

Ich werde gleich ausprobieren (lassen), ob das angepasste Script etwas bringt.
Soweit ich mich erinnern kann, bricht Excel nach etwa 100 Dateien ab.

Aber eben, früher lief es. Ich könnte mir vorstellen, dass der Speicher durch eine völlig andere Applikation stärker belastet wird. Dann könnten deine Optimierung schon helfen. Ich werde das bald wissen.

Seltsam ist es dennoch. Danke für deine Verbesserungen.


  

Betrifft: AW: Die Methode 'Open' für das Objekt 'Workbooks' ist von: Christian Zumbrunnen
Geschrieben am: 08.03.2016 13:23:36

Tatsächlich läuft es mit der verbesserten Version.

Allerdings erst, nachdem ich bei:

... 'Bereich in der Tabelle, welcher kopiert werden soll ( _
  Feldwert(e)):
die zweite Zeile auskommentiert habe.

Ist hier einfach der Doppelpunkt falsch, oder was läuft hier ab?


  

Betrifft: AW: Die Methode 'Open' für das Objekt 'Workbooks' ist von: fcs
Geschrieben am: 09.03.2016 07:12:21

Hallo Christian,


freut mich, dass meine Anpassungen erfolgreich waren. Es ist ja nicht immer einfach, solche Vorschläge in einem Makro umzusetzen ohne Tests machen zu können.

Fehler:
Da hatte ich bei meiner Antwort nicht bemerkt, dass die Forums-Software am Ende der Zeile dem Kommentar noch eine Zeilenschaltung mit dem "_" verpasst hat. Dadurch dann der Fehler.

Gruß
Franz


 

Beiträge aus den Excel-Beispielen zum Thema "Die Methode 'Open' für das Objekt 'Workbooks' ist "