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
[SIZE="1"]Wer tolerant ist, hält sich selbst für besser ("Gott, ich danke dir, daß ich nicht bin wie dieser da. Aber in meiner großen Güte dulde ich ihn neben mir"). Tolerare heißt nur "erdulden" oder "ertragen". Wie wäre es stattdessen mit Akzeptanz oder sogar Respekt vor dem Andersartigen?[/SIZE]
