VBA-Profi gesucht....

  • geschlossen

Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

  • VBA-Profi gesucht....

    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
    [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]
  • 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.
  • Dr.S. schrieb:

    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.
  • 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
    [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]