Office: Datei nur öffnen falls noch geschlossen

moses64 · 27. Februar 2014

Hallo Leute,
Ich kämpfe schon mindestens 5min. (oder mehr) an folgendem Problem.
Ich möchte ein Arbeitsblatt aus einer anderen Mappe kopieren. Dies mache ich mit folgendem Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("C6:C24")) Is Nothing Then Exit Sub
If Target = "" Then
MsgBox "Keine Auftrags-Nr vorhanden !", vbInformation
Exit Sub
End If
Cancel = True

With Workbooks.Open("D:\Berichte\Vorlage Bericht.xlsm").Worksheets("Bericht")
.Copy after:=ThisWorkbook.Sheets(Worksheets.Count)
ActiveSheet.Name = "Bericht " & Target.Value
End With
Workbooks("Vorlage Bericht.xlsm").Save
Workbooks("Vorlage Bericht.xlsm").Close

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nun kommt aber eine Meldung mit "Datei schon geöffnet" falls diese schon auf ist. Im Netz habe ich flogende Abfrage gefunden die dies überprüft.

Public Sub TestePfad()
Dim sPfad As String
sPfad = "D:\Berichte\Vorlage Bericht.xlsm" ' Pfad ändern für Tests
If DateiGeoeffnet(sPfad) = False Then
Workbooks.Open Filename:=sPfad
Else
End If
End Sub

Private Function DateiGeoeffnet(DerPfad As String) As Boolean
' Bei shared Workbooks, schreibgeschützten Mappen o.ä.. kann dies auch ein falsch zurückgeben.
On Error Resume Next
Open DerPfad For Binary Access Read Lock Read As #1
Close #1
If Err.Number 0 Then
DateiGeoeffnet = True
Err.Clear
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie muss ich jetzt den unteren Code in meinen schon vorhandenen Code einpflegen damit das Funktioniert?
Danke schon mal für Eure Hilfe und

bis später
Gottlieb

:)

aloys78 · 28. Februar 2014

Hallo Gottlieb,

mein Vorschlag:
Code:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("C6:C24")) Is Nothing Then Exit Sub
If Target = "" Then
MsgBox "Keine Auftrags-Nr vorhanden !", vbInformation
Exit Sub
End If
Cancel = True

Dim w As Long
Dim sw As Boolean
For w = 1 To Workbooks.Count
If Workbooks(w).Name = "Vorlage Bericht.xlsm" Then
sw = True 'Workbook schon geöffnet
Exit For
End If
Next w
If sw = False Then
Workbooks.Open ("D:\Berichte\Vorlage Bericht.xlsm")
End If

With Workbooks("Vorlage Bericht.xlsm").Worksheets("Bericht")
.Copy after:=ThisWorkbook.Sheets(Worksheets.Count)
ActiveSheet.Name = "Bericht " & Target.Value
End With
Workbooks("Vorlage Bericht.xlsm").Save
Workbooks("Vorlage Bericht.xlsm").Close
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß
Aloys

Beverly · 28. Februar 2014

Hi Gottlieb,

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("C6:C24")) Is Nothing Then Exit Sub
Cancel = True
If Target = "" Then
MsgBox "Keine Auftrags-Nr vorhanden !", vbInformation
Exit Sub
End If
If Dir("D:\Berichte\Vorlage Bericht.xlsm") "" Then
Application.DisplayAlerts = False
If DateiOffen("D:\Berichte\Vorlage Bericht.xlsm") = True Then
Workbooks.Open "D:\Berichte\Vorlage Bericht.xlsm"
End If
Application.DisplayAlerts = True
With Workbooks("Vorlage Bericht.xlsm").Worksheets("Bericht")
.Copy after:=ThisWorkbook.Sheets(Worksheets.Count)
ActiveSheet.Name = "Bericht " & Target.Value
End With
Workbooks("Vorlage Bericht.xlsm").Save
Workbooks("Vorlage Bericht.xlsm").Close
Else
MsgBox "Datei nicht vorhanden"
End If
End Sub

Function DateiOffen(strDatei As String) As Boolean
Dim inFile As Integer
inFile = FreeFile()
Open strDatei For Random Access Read Lock Read Write As #inFile
If Err Then
DateiOffen = False
Else
DateiOffen = True
End If
Close #inFile
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

moses64 · 1. März 2014

Danke für die schnelle Antwort.
Hab mich für die Lösung von Aloys entschieden, da brauch ich das mit der Funktion nicht. (Oder wäre die Lösung von Karin besser??)

Beverly · 1. März 2014

Beide Lösungen führen zum selben Ergebnis - für welche du dich entscheidest, bleibt ganz allein dir überlassen. Ich habe die mit einer Function gepostet, da du bereits einen entsprechenden Vorschlag gemacht hattest. Die Function-Lösung wäre in dem Fall günstiger, wenn sehr viele andere Arbeitsmappen geöffnet sind, da sie direkt nur die relevante Arbeitsmappe prüft und nicht in einer Schleife über alle geöffneten laufen muss.

moses64 · 2. März 2014

Danke Karin für die Info und bis zum nächsten Problem

gruß
Gottlieb

ebs17 · 2. März 2014

Nachtrag:
- Die Funktion DateiOffen prüft, ob eine beliebige Datei (nicht nur eine Excelmappe) offen ist. Sie ist damit universell einsetzbar.
- Allerdings könnte eine Excelmappe in einem anderen als dem aktuellen Excelprozess geöffnet sein. Wegen des dann in Folge etwas anderen Zugriffes auf die Mappe kann dann die Information "geöffnet" nicht ausreichend sein.
- Die Methode von Aloys liefert die offenen Mappen des aktuellen Prozesses.

Ergo: Was besser ist, muss man auch an Hand von vorliegenden (und möglichen) Rahmenbedingungen prüfen.

EarlFred · 2. März 2014

Hallo,

ergänzend / alternativ: Anstelle Workbooks.Open könnte man Getobject verwenden: Die Datei wird geöffnet, wenn geschlossen oder gefunden, auch wenn in einer anderen Instanz geöffnet.

Es sind allerdings nicht alle Aktionen instanzübergreifend möglich, daher ist eine Prüfung unabdingbar, wenn solche Aktionen ausgeführt werden sollen.

Code:

With GetObject("D:\Berichte\Vorlage Bericht.xlsm")
If .Application Is Application Then
.Worksheets("Bericht").Copy after:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = "Bericht " & Target.Value
.Close Savechanges:=True
Else
MsgBox "Vorgang ist auf ein Workbook in einer anderen Instanz nicht anwendbar!"
End If
End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hier wäre allerdings noch zu prüfen, ob das Schließen der Datei in jedem Fall gewünscht ist.

Grüße
EarlFred

Beverly · 12. Januar 2021

von ebs17

- Allerdings könnte eine Excelmappe in einem anderen als dem aktuellen Excelprozess geöffnet sein.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Falls die Mappe in einer anderen Instanz geöffnet ist, läuft die DateiOffen-Funktion auf einen Fehler. Durch die folgende Code-Ergänzung wird automatisch in den If-Zweig gegangen, wenn sie bereits geöffnet ist - gleichgültig in welcher Instanz:

Code:

Function DateiOffen(strDatei As String) As Boolean
Dim inFile As Integer
On Error Resume Next
inFile = FreeFile()
Open strDatei For Random Access Read Lock Read Write As #inFile
If Err Then
DateiOffen = False
Else
DateiOffen = True
End If
On Error GoTo 0
Close #inFile
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ebs17 · 2. März 2014

Präzisierung: Der Versuch, eine Datei exklusiv zu öffnen, wie in DateiOffen ausgeführt, erzeugt bei einer geöffneten Datei (egal wo geöffnet) in jedem Fall einen Fehler. Das ist ja gerade das Prinzip des Testes.

Logischerweise sollte man den bewusst hervorgerufenen Fehler auch gleich wieder abfangen.

Beverly · 12. Januar 2021

von ebs17

Logischerweise sollte man den bewusst hervorgerufenen Fehler auch gleich wieder abfangen.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das ist in dem Code doch berücksichtigt.

Office: Datei nur öffnen falls noch geschlossen

Datei nur öffnen falls noch geschlossen

Datei nur öffnen falls noch geschlossen

Datei nur öffnen falls noch geschlossen

Datei nur öffnen falls noch geschlossen

Datei nur öffnen falls noch geschlossen - Similar Threads - Datei öffnen geschlossen

Datei in mehreren Ordnern suchen und wenn gefunden öffnen?! Macro / VBA

Dateien bei Öffnen aus der Cloud schreibgeschützt

Zugriff auf andere Excel Datei ohne aktives Öffnen

Öffnen einer pptx Datei endet mit "unbekannter Fehler"

sharepoint - Dateien in Desktopapps öffnen

Öffnen einer bestimmten Seite einer pdf-Datei

Dateien werden geschlossen und lassen sich nicht mehr öffnen