VBA-Profi gesucht.... geschlossen

[Fjolnir]

Hallo zusammen,

eine liebe Freundin hat ein Excel-Problem. Soweit ich Ihr helfen konnte habe ich das getan (einen Teil des VBA) haben wir hingebracht. Nun steige ich aber aus...vielleicht weiß ja hier jemand Rat, wie das weitergeht....

Es geht um folgendes Problem:

Script (1)(siehe unten) öffnet verschiedene Dateien und Schneidet Zeilen aus, fügt diese in einer neuen ein und gut ist:

Beispiel:

• Öffne die Datei "Tore_A1.xls"
• Schneide die Daten aus, füge die in Gesamt ein
• Speichere die Datei "Tore_A1.xls"

Nun kann es aber (Murphys Law) sein, das gerade jemand die Datei "Tore_A1.xls" bearbeitet (etc.).

Problem1:

• Prüfe ob die jeweilige Datei (im Beispiel Tore_A1.xls") geöffnet ist
• -> wenn nein -> dann führe das Script aus
• -> wenn ja -> dann springe zum nächsten "öffnen-Punkt" (im Beispiel zu Tore_A2.xls) und prüfe das gleiche (etc.etc.)

Hier habe ich im Netz etwas dazu gefunden (siehe Script 2 unten) - nur weiß ich nicht, wie ich richtigerweise Script 1 und Script 2 verbinde - weil ich will ja nicht eine "Meldung per MSGBox haben" - sondern das Script soll "weiterlaufen - und ggf. die geöffnete Datei überspringen".

Lieben Dank für jegliche Tipps!

Diago (für die liebe Freundin)

Script 1:
Sub Dateien_in_eine_Tabelle_zusammenfuehren()
Dim Datei As String
Dim Arbeitsmappe As String
Dim Pfad As String
Pfad = "G:\Jugendsport\"
Datei = Dir(Pfad & "*.xls")
Application.ScreenUpdating = False
'Active Mappe
Arbeitsmappe = ActiveWorkbook.Name




'Öffnet eine Datei
Workbooks.Open Filename:="G:\Jugendsport\Tore_A1.xls"
'Kopiert von den Zeilen 2 bis zum Ende
'in die aktive Mappe und fügt sie jeweils unten an
If ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row > 1 Then
Rows("2:" & ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row).Cut _
Destination:=Workbooks(Arbeitsmappe).ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
End If
'Schliesst die geöffnete Datei
ActiveWorkbook.Save
ActiveWindow.Close


'Öffnet eine Datei
Workbooks.Open Filename:="G:\Jugendsport\Tore_A2.xls"
'Kopiert von den Zeilen 2 bis zum Ende
'in die aktive Mappe und fügt sie jeweils unten an
If ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row > 1 Then
Rows("2:" & ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row).Cut _
Destination:=Workbooks(Arbeitsmappe).ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
End If
'Schliesst die geöffnete Datei
ActiveWorkbook.Save
ActiveWindow.Close



'Öffnet eine Datei
Workbooks.Open Filename:="G:\Jugendsport\Tore_A3.xls"
'Kopiert von den Zeilen 2 bis zum Ende
'in die aktive Mappe und fügt sie jeweils unten an
If ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row > 1 Then
Rows("2:" & ActiveWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row).Cut _
Destination:=Workbooks(Arbeitsmappe).ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
End If
'Schliesst die geöffnete Datei
ActiveWorkbook.Save
ActiveWindow.Close

Application.ScreenUpdating = True
End Sub

Script 2 (aus dem Netz):

Sub TestObFileGeoeffnet()
'Ist auch fürs Netzwerk geeignet
Dim xfn&
Dim xPathAndFile$
xPathAndFile = "N:\test1.xls"

xfn = FreeFile
On Error Resume Next
Open xPathAndFile For Binary Lock Read Write As xfn
Close xfn

Select Case Err.Number
Case 0
MsgBox xPathAndFile & " ist nicht geöffnet", , ""
Case 70
MsgBox Err.Description, , xPathAndFile & " bereits geöffnet"
Case 76
MsgBox Err.Description, , xPathAndFile & " nicht gefunden"
Case Else
MsgBox Err.Description, , "Fehler"
End Select
Err.Clear
On Error GoTo 0

End Sub

 

[Dr.S.]

Hi,

nach dem Deklarieren der Variablen habe ich normalerweise ein

On Error GoTo Errorhandling


und am Ende

Exit Sub
Errorhandling:
Skip = True
Resume Next
End Sub

Das bewirkt dann, dass das Makro einfach weitermacht, wenn es auf einen Fehler stösst.

hth
Gruss
Dr.S.

 

[FeliX_22]

Das bewirkt dann, dass das Makro einfach weitermacht, wenn es auf einen Fehler stösst.

Finde ich nicht so sinnvoll.

Auf die schnelle: Packe deine 3 fast identischen Zeilen in jeweils eine eigene Sub und erzeuge zwei weitere, ebenfalls fast identische Err.Number-Tests. Dann rufst du bei Err.Number = 0 nur noch die jeweilige Sub auf.

 

[Fjolnir]

Servus zusammen,

manchmal ist die Lösung so nah, das man die nicht sieht

@FeliX_22 - Du sagst es - dann habe ich viele Probleme auf einmal gelöst (!)

Lieben Dank und Liebe Grüße

Fjolnir

 

[FeliX_22]

Freut mich, dass ich helfen konnte, aber ich bin trotzdem kein VBA-Profi

Denk dran, den Präfix umzustellen, sonst mach das gleich der

@Mod
Sorry wegen dem Doppelpost und der Beteiligung an den Ausgrabungen neulich.

 

[Imperator]

- closed -

mfg
Imperator