Supportnet / Forum / Tabellenkalkulation
Harte Nuss!?!? Makro Fehler überspringen!!
Frage
Hallo,
Ich habe ein für mich großes Problem.
Das folgende Makro geht in einen Ordner und kopiert Felder aus den im Ordner befindenden .xls Dateien. Wenn er mit einem fertig ist, dann geht er in die nächste Datei und macht das gleiche. Dadurch erhalte ich eine übersichtliche einzelne Datei.
Das Problem ist, wenn jemand die Quelldatei offen hat, kann das makro nicht weiter machen und hört auf.
gibt es eine Möglichkeit, bei solchen Fehlern einfach mit der nächsten Datei weiterzumachen?
Würdet mir sehr helfen, wenn Ihr das auf dieses Makro anpassen könntet.
Sub übersicht()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Geschäft"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)
ActiveWindow.ScrollRow = 1
Sheets("Exec. Summary").Select
Range("C5").Select Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("A" & zeile + 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Activate
ActiveWindow.ScrollRow = 1
Sheets("Input Sheet").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Close
Next Mappen
End If
End With
End Sub
Vielen Dank
Antwort 1 von nostalgiker6
Das müsste doch mit dem guten alten "on error" gehen, wobei es wohl gut wäre, die erst Fehlerart zu klären.
Antwort 2 von Muster
Danke erstmal für diesen Tipp.
hab leider keine Ahnung wie man das einbauen kann?
Das Problem ist wenn ein anderer Benutzer im Netzwerk die Datei offen hat. Kann man die ja nur schreibgeschützt öffnen. Und um das zu entgehen. Da ich das Makro laufen lassen will, wenn ich nicht da bin. Will ich dass es nicht durch die Fragen "speichern ja nein" oder Aktualisieren wegen verknüpfungen oder sowas gestoppt wird.
Und vor allem dass es weiterläuft wenn jemand anderes eine von 800 Dateien offen hat.
Es soll dann einfach zur nächsten übergehen.
Danke!
hab leider keine Ahnung wie man das einbauen kann?
Das Problem ist wenn ein anderer Benutzer im Netzwerk die Datei offen hat. Kann man die ja nur schreibgeschützt öffnen. Und um das zu entgehen. Da ich das Makro laufen lassen will, wenn ich nicht da bin. Will ich dass es nicht durch die Fragen "speichern ja nein" oder Aktualisieren wegen verknüpfungen oder sowas gestoppt wird.
Und vor allem dass es weiterläuft wenn jemand anderes eine von 800 Dateien offen hat.
Es soll dann einfach zur nächsten übergehen.
Danke!
Antwort 3 von coros
Hi Muster,
das sollte mit nachfolgendem Makro, in das die Änderung bereits mit eingearbeitet ist (Änderung habe ich Unterstrichen) funktionieren. Ich konnte es allerdings leider nicht testen, da ich keine Meinung habe, mir Deine Datei usw. nach zu bauen. Es wird lediglich über eine weitere For/ Each-Schleife geprüft, ob die Datei bereits geöffnet ist.
Man hätte auch mit einer „On Error Resume Next-Anweisung“ anstelle der Schleife arbeiten können. Aber Vorteil der Schleife, man könnte durch die Auswertung veranlassen, dass die Datei nicht mehr geöffnet werden muss, sondern man könnte dann sofort ab der Anweisung "ActiveWindow.ScrollRow = 1
" weitermachen lassen ohne dass die Workbooks.Open - Anweisung mit abgearbeitet werden muss.
Ich hoffe, meine Änderung funktioniert und dass Du klar kommst und alles verstanden hast. Ansonsten nachfragen bitte.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
das sollte mit nachfolgendem Makro, in das die Änderung bereits mit eingearbeitet ist (Änderung habe ich Unterstrichen) funktionieren. Ich konnte es allerdings leider nicht testen, da ich keine Meinung habe, mir Deine Datei usw. nach zu bauen. Es wird lediglich über eine weitere For/ Each-Schleife geprüft, ob die Datei bereits geöffnet ist.
Sub übersicht()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer, Datei, Datei_vorhanden As Boolean
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Geschäft"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
For Each Datei In Workbooks
If Datei.Name = .FoundFiles(Mappen) Then
Datei_vorhanden = True
Exit For
End If
Next Datei
If vorhanden = True Then
Workbooks.Open Filename:=.FoundFiles(Mappen)
ActiveWindow.ScrollRow = 1
Sheets("Exec. Summary").Select
Range("C5").Select Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("A" & zeile + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Activate
ActiveWindow.ScrollRow = 1
Sheets("Input Sheet").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Close
End If
Next Mappen
End If
End With
End Sub
Man hätte auch mit einer „On Error Resume Next-Anweisung“ anstelle der Schleife arbeiten können. Aber Vorteil der Schleife, man könnte durch die Auswertung veranlassen, dass die Datei nicht mehr geöffnet werden muss, sondern man könnte dann sofort ab der Anweisung "ActiveWindow.ScrollRow = 1
" weitermachen lassen ohne dass die Workbooks.Open - Anweisung mit abgearbeitet werden muss.
Ich hoffe, meine Änderung funktioniert und dass Du klar kommst und alles verstanden hast. Ansonsten nachfragen bitte.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 4 von coros
Hi,
ich noch mal. Da hat sich beim kopieren der Variablen "Datei_vorhanden" ein kleiner Fehler eingeschlichen. Nachfolgend noch mal das richtige Makro.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
ich noch mal. Da hat sich beim kopieren der Variablen "Datei_vorhanden" ein kleiner Fehler eingeschlichen. Nachfolgend noch mal das richtige Makro.
Sub übersicht()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer, Datei, Datei_vorhanden As Boolean
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Geschäft"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
For Each Datei In Workbooks
If Datei.Name = .FoundFiles(Mappen) Then
Datei_vorhanden = True
Exit For
End If
Next Datei
If Datei_vorhanden = True Then
Workbooks.Open Filename:=.FoundFiles(Mappen)
ActiveWindow.ScrollRow = 1
Sheets("Exec. Summary").Select
Range("C5").Select Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("A" & zeile + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Activate
ActiveWindow.ScrollRow = 1
Sheets("Input Sheet").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Test.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Range("B" & zeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Close
End If
Next Mappen
End If
End With
End Sub
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.