Prüfen ob Datei offen

22.10.2025 21:40:18

Dieter

Hi alle,

ich fülle mit einem Makro eine geschlossene Excel Datei mit Informationen aus einer Word Datei. Das funktioniert solang die Excel Datei nicht offen ist. Wenn aber die betroffene Excel Datei offen ist und im Word Dokument das Makro ausgeführt wird werden keine Daten in die Excel kopiert bzw. es hängt sich auf ohne Fehlermeldung.

Müsste ich zuerst prüfen ob die Datei offen ist? Wenn ja wie soll ich dann weiter verfahren das die bereits offene befüllt wird?



    Dim xlApp As Object

    Dim xlMappe As Object

    Dim xlBlatt As Object



    Set xlApp = CreateObject("Excel.Application")

    Set xlMappe = xlApp.Workbooks.Open("Dateipfad")

    Set xlBlatt = xlMappe.Sheets("Tabelle1")



        With xlMappe.Sheets("Tabelle1")

            'Daten die in die Excel geschrieben werden sollen

        End With



        xlMappe.Close SaveChanges:=True

        Set xlBlatt = Nothing

        Set xlMappe = Nothing

        xlApp.Application.Quit

        Set xlApp = Nothing

Google: IsFileOpen. owT

22.10.2025 22:35:07

Uduuh

Du könntest dir auch...

23.10.2025 12:52:58

Case

Moin Dieter, :-)

... die "GetObject-Funktion" anschauen: ;-)
https://learn.microsoft.com/de-de/office/vba/language/reference/user-interface-help/getobject-function

Also so der Spur nach: ;-)

Dim xlApp As Object

Dim xlMappe As Object

Dim xlBlatt As Object

'Set xlApp = CreateObject("Excel.Application")

Set xlMappe = GetObject("C:\Temp\975v.xlsx")

Set xlBlatt = xlMappe.Sheets("Tabelle1")

With xlBlatt

    .Range("A2").Value = "NurEinTest"

    'Daten die in die Excel geschrieben werden sollen

End With

xlMappe.Windows(1).Visible = True

xlMappe.Close SaveChanges:=True

Set xlBlatt = Nothing

Set xlMappe = Nothing

'Set xlApp = Nothing

"GetObject" öffnet die Datei, oder nimmt die schon geöffnete. ;-)

Das kann man noch mit diversen Fehlerbehandlungen ausbauen - wenn man will. ;-)

"With xlMappe.Sheets("Tabelle1")" ist doppelt gemoppelt. Da reicht "With xlBlatt". ;-)

Da "GetObject" ausgeblendet öffnet und du speicherst, musst du vorher wieder einblenden, sonst ist die Datei beim nächsten öffnen nicht sichtbar. ;-)

Ahh - und da wir gerade dabei sind - "Ich mag keine Rote Beete!". ;-)

Servus
Case

AW: Du könntest dir auch...

23.10.2025 17:35:46

Dieter

Hi Case,

ich glaube ich check es nicht. Ich habe hier einen Beitrag "Thema: Prüfen, ob Arbeitsmappe geöffnet und wenn nein, öffnen" gefunden das mein Problem lösen könnte, aber so ganz kann ich es nicht umsetzen. Im Makro wird geprüft ob die Datei offen ist. Wenn die Datei nicht offen ist läuft das Makro durch. Wenn die Datei offen ist hängt es sich auf ohne Meldung.

Der unten abgebildete Code ist ohne den Kopiervorgang von Word in Excel, weil dieser glaube ich nicht mein Problem ist. Kann mir bitte wer sagen was ich falsch gemacht habe? Bestimmt einiges. Ich habe es nach besten wissen versucht :-/



Sub DatenKopieren()

    Dim xlApp As Object 'Excel.Application

    Dim xlMappe As Object 'Excel.Workbook

    Dim xlBlatt As Object 'Excel.Worksheet

    Dim wdDocument As Document

    Dim rngTable As Range

    Dim wbOpen,  As String



    wbOpen = "Arbeitsdokument.xlsm"



    If WkbExists( "Arbeitsdokument.xlsm") = False Then

        If Dir(Folder) = "" Then

            MsgBox "Datei " & Folder & " wurde nicht gefunden!"

        Else

            Application.ScreenUpdating = False

            'Set Document verwende ich um die Infos aus einer Word Tabelle in Excel zu schieben

            Set wdDocument = ActiveDocument

            Set rngTable = wdDocument.Tables(1).Cell(1, 2).Range

        

            Set xlApp = CreateObject("Excel.Application")

            xlApp.Visible = False

            xlApp.ScreenUpdating = False

            Set xlMappe = xlApp.Workbooks.Open(Folder)

            Set xlBlatt = xlMappe.Sheets("Tabelle1")



            With xlBlatt

               'Informationen kopieren

            End With

        

            xlMappe.Close SaveChanges:=True

            Set xlBlatt = Nothing

            Set xlMappe = Nothing

            xlApp.Application.Quit

            Set xlApp = Nothing

            Application.ScreenUpdating = True

        End If

    Else

        Application.ScreenUpdating = False

        Workbooks(Folder).Activate

        Set wdDocument = ActiveDocument

        Set rngTable = wdDocument.Tables(1).Cell(1, 2).Range

    

        Set xlApp = CreateObject("Excel.Application")

        xlApp.ScreenUpdating = False

        Set xlMappe = Workbooks(Folder)

        Set xlBlatt = xlMappe.Sheets("Tabelle1")

    

        With xlBlatt

            'Informationen kopieren

        End With

    

        xlMappe.Close SaveChanges:=True

        Set xlBlatt = Nothing

        Set xlMappe = Nothing

        Set xlApp = Nothing

        Application.ScreenUpdating = True

    End If

End Sub



'Function aus dem Forum

Private Function WkbExists(sPath As String) As Boolean

   Dim wkb As Object

   On Error Resume Next

   Set wkb = Workbooks(sPath)

   If Not wkb Is Nothing Then

      WkbExists = True

   End If

   On Error GoTo 0

End Function

Da müsste aber...

23.10.2025 18:56:44

Case

Moin Dieter, :-)

... einiges angepasst werden. ;-)

Ich habe den Code in Word: ;-)

Option Explicit

Public Sub Main()

    Dim xlApp As Object

    Dim xlMappe As Object

    Dim xlBlatt As Object

    Set xlMappe = GetObject("C:\Temp\Arbeitsdokument.xlsx")

    Set xlBlatt = xlMappe.Sheets("Tabelle1")

    With xlBlatt

        .Range("C2").Value = "NurEinTest"

        'Daten die in die Excel geschrieben werden sollen

    End With

    With xlMappe

        .Windows(1).Visible = True

        .Save

        .Parent.Quit

    End With

    Set xlBlatt = Nothing

    Set xlMappe = Nothing

End Sub

Und er läuft - egal, ob die Datei offen ist oder nicht. ;-)

Funktioniert das bei dir, wenn du den Pfad- und Dateinamen (und gegebenenfalls den Tabellenblattnamen) auf deine Gegebenheiten anpasst? ;-=

Servus
Case

AW: Da müsste aber...

24.10.2025 13:22:05

Dieter

Hi Case,

sorry das ich erst jetzt schreibe aber ich habe ewig rum probiert und weiß nicht wieso es bei mir nicht läuft. Wenn ich deinen Code hernehme erhalte ich immer diese Meldung "Methode rows für das globale Objekt ist fehlgeschlagen". "rows" verweißt auf den Code der bei mir zwischen "With xlBlatt...." steht (siehe unten).



With xlBlatt

        intLastRow1 = .Cells(Rows.Count, 2).End(xlup).Row + 1

        If intLastRow1  17 Then intLastRow1 = 17

        .Range("C2").Value = "NurEinTest"

End With

Mit dem erhalte ich die Fehlermeldung:



Set xlMappe = GetObject(Folder)

Set xlBlatt = xlMappe.Sheets("Tabelle1")

und hiermit nicht:



Set xlApp = CreateObject("Excel.Application")

Set xlMappe = xlApp.Workbooks.Open(Folder)

Set xlBlatt = xlMappe.Sheets("Tabelle1")

Aber wenn ich meinen Code verwende kann ich nur in die Excel schreiben wenn diese nicht bereits offen ist. Mir kommt es so vor als würde die Excel Datei ohne Open nicht angesteuert oder gefunden.

Du hast also offensichtlich...

24.10.2025 14:02:10

Case

Moin Dieter, :-)

... einen Verweis auf die Excelbibliothek gesetzt, sonst würde er "xlup" auch anmeckern. Du musst aber auch berücksichtigen, dass bei With alle Zugehörigen mit Punkt versehen werden müssen: ;-)

Option Explicit

Public Sub Main()

    Dim lngLastRow As Long

    Dim xlMappe As Object

    Dim xlBlatt As Object

    Dim xlApp As Object

    Set xlMappe = GetObject("C:\Temp\Arbeitsdokument.xlsx")

    Set xlBlatt = xlMappe.Sheets("Tabelle1")

    With xlBlatt

        lngLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1

        If lngLastRow  17 Then lngLastRow = 17

        .Cells(lngLastRow, 2).Value = "NurEinTest"

    End With

    With xlMappe

        .Windows(1).Visible = True

        .Save

        .Parent.Quit

    End With

    Set xlBlatt = Nothing

    Set xlMappe = Nothing

End Sub

Der Punkt vor Rows ist wichtig. ;-)

Servus
Case

AW: Du hast also offensichtlich...

24.10.2025 16:17:09

Dieter

Danke Case, jetzt funktioniert es wenn ich die Excel vorher nicht offen habe. Aber wieso ging es vorher mit "Set xlApp = CreateObject("Excel.Application")"?

Wenn ich jetzt die Excel Datei offen habe und das Makro aktiviere bekomme ich folgende Fehlermeldung "Laufzeitfehler 432: Datei- oder Klassenname während Automatisierungsoperation nicht gefunden. Wenn ich die Excel Datei schließe und dann das Makro in Word ausführe geht es wieder.

Wie kann es sein das er jetzt die Datei nicht mehr findet?

Das liegt in der...

24.10.2025 17:14:03

Case

Moin Dieter, :-)

... Regel daran, wenn mehrere Excel-Instanzen offen sind. Die werden in der ROT registriert: ;-)
https://learn.microsoft.com/en-us/windows/win32/com/registering-objects-in-the-rot

"GetObject" nimmt sich in der Regel die erste Instanz davon - und das muss nicht die mit deiner Datei sein. ;-)

"CreateObject" erstellt eine neue Instanz - da geht es immer. ;-)

Sind bei dir mehrere Instanzen von Excel offen, dann kann man entweder die ROT durchlaufen, oder mit einer Dummy-Schleife mehrere Instanzen durchlaufen und dann die richtige Datei schnappen. ;-)

Servus
Case

AW: Das liegt in der...

24.10.2025 19:42:33

Dieter

Dann hat meine erste Idee abzufragen ob die Excel Datei bereits offen ist gar keinen Sinn ergeben? Ich hätte jetzt gedacht wenn die Datei offen ist und ich diese einfach nochmal Abfrage bzw. den Dateinamen und das Sheet angebe in das geschrieben werden soll dass das dann läuft.

Wie soll ich es jetzt machen damit alle möglichen Varianten abgefangen werden?
Mögliche Fälle können sein:
1. Nur die eine Word Datei die ich ausführen möchte ist offen
2. Mehrere unterschiedliche Word Dateien sind offen aber ich führe nur die eine aus
3. Die Ziele Excel Datei ist offen
4. Die Ziel Excel Datei ist offen und andere

Wie geht das mit der ROT?

Grüße Dieter

Probiere diesen...

24.10.2025 21:20:34

Case

Moin Dieter, :-)

... Code: ;-)

Option Explicit

Public Sub Main()

    Dim objXlMappe As Object

    Dim objXlSheet As Object

    Dim blnFound As Boolean

    Dim objXlApp As Object

    Dim objWBook As Object

    Dim lngLastRow As Long

    Dim strPath As String

    strPath = "C:\Temp\Arbeitsdokument.xlsx"

    On Error Resume Next

    Set objXlApp = GetObject(, "Excel.Application")

    On Error GoTo Fin

    If objXlApp Is Nothing Then

        Set objXlApp = CreateObject("Excel.Application")

    End If

    For Each objWBook In objXlApp.Workbooks

        If StrComp(objWBook.FullName, strPath, vbTextCompare) = 0 Then

            Set objXlMappe = objWBook

            blnFound = True

            Exit For

        End If

    Next objWBook

    If Not blnFound Then

        Set objXlMappe = objXlApp.Workbooks.Open(strPath)

    End If

    Set objXlSheet = objXlMappe.Sheets("Tabelle1")

    With objXlSheet

        lngLastRow = .Cells(.Rows.Count, 2).End(-4162).Row + 1 ' xlUp

        If lngLastRow  17 Then lngLastRow = 17

        .Cells(lngLastRow, 2).Value = "NurEinTest"

    End With

    objXlMappe.Save

    objXlApp.Visible = True

Fin:

    If Err.Number > 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description

    Set objXlSheet = Nothing

    Set objXlMappe = Nothing

    Set objXlApp = Nothing

End Sub

Der sollte eigentlich alles "erschlagen". ;-)

Starte aber deine Kiste mal neu. Falls du schon viel mit "CreateObject" gearbeitet hast (oder schau mal in den Task-Manager. Nicht dass da noch Excel-Leichen sind). ;-)

Servus
Case

Läuft mega

26.10.2025 08:11:19

Dieter

Morgen Case,

ich konnte leider erst jetzt deinen Code testen, aber besser spät als nie :D Ich habe gerade ein paar Fälle ausprobiert, aber dein Code läuft top durch. Vielen Dank du hast mich gerettet. Dir noch einen schönen Sonntag ;-)

Hast Du mal ...

23.10.2025 19:13:35

schauan

... hast Du den Code von Case getestet? Was passiert da? Der funktioniert eigentlich einwandfrei...

... meine beiden Hinweise getestet? Die wären z.B. interessant, Wenn Deine Datei von einem anderen User in Benutzung ist.

Also
If xlMappe.Readonly ...
Oder
Open Datei For Binary Access Read Write Lock Read Write As #1
Close #1

If xlMappe.Readonly ...

23.10.2025 11:21:48

schauan

ansonsten, Du füllst eindeutig keine geschlossene Datei - Du machst sie dazu ja auf...

Alternativ ginge auch
Open Datei For Binary Access Read Write Lock Read Write As #1
Close #1
Das würde bei geöffneter Datei einen Fehler bringen, den man auswerten kann.

PS: ich bin eigentlich kein Freund davon, den Betreff zu ändern. :-(
Aber ich mach auch gerne mit :-)
Die Antwortmails zuzuordnen macht doch immer Spaß, oder? :-) :-)

Prüfen ob Datei offen

Forumthread: Prüfen ob Datei offen

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Prüfen ob Datei offen

Forumthread: Prüfen ob Datei offen

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread