Prüfen ob Datei bereits geöffnet

Hallo zusammen,
ich hatte hier vor kurzem von ChrisL diesen Code bekommen, leider war der Thread nicht mehr offen, aber ich hatte nun noch eine Frage:
Hier der Link zum Archiv-Thread:
https://www.herber.de/forum/archiv/1468to1472/t1470348.htm


Sub t()
Dim WB1 As Workbook, WB2 As Workbook
Dim varDatei As Variant
Application.ScreenUpdating = False
Set WB1 = ThisWorkbook
ChDrive "T:"
ChDir "T:\~Betrieb_Waghäusel\~Kommissionierung\~GL Kommissionierung\Allgemein\ _
Parametereinstellungen\"
varDatei = Application.GetOpenFilename("Excel Datei (*.xlsm), *.xlsm", , "Datei auswählen", ,  _
False)
If varDatei  False Then
Set WB2 = Workbooks.Open(varDatei)
Else
Exit Sub
End If
End If
WB2.Worksheets(2).Range("M2:S43").Copy WB1.Worksheets(2).Range("M2")
WB2.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

In diesem Code habe ich zwei Zeilen eingefügt die mir bereits den Pfad vorgeben:


ChDrive "T:"
ChDir "T:\~Betrieb_Waghäusel\~Kommissionierung\~GL Kommissionierung\Allgemein\ _
Parametereinstellungen\"

Ich möchte allerdings nun noch abfangen, ob die Datei die ich ausgewählt habe bereits geöffnet ist, sodass keine Fehlermeldung kommt beim ausführen.
Vielen Dank & Grüße,
Nicolai

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim WB2 As Workbook Dim i As Integer, nurDatei As String varDatei = Application.GetOpenFilename("Excel Datei (*.xlsm), *.xlsm", , _ "Datei auswählen", , False) If varDatei False Then 'Position letztes '\' im Pfad+Dateiname ermitteln i = InStrRev(varDatei, "\", -1, vbTextCompare) 'nur den Dateinames rausfiltern nurDatei = Mid(varDatei, i + 1) On Error Resume Next 'Testöffnung Set WB2 = Workbooks(nurDatei) On Error GoTo 0 If WB2 Is Nothing Then Set WB2 = Workbooks.Open(varDatei) Else MsgBox "AM '" & nurDatei & "' ist schön geöffnet!", vbSystemModal + 48, "Hinweis..." End If Else Exit Sub End If

Sub t() Dim WB1 As Workbook, WB2 As Workbook Dim varDatei As Variant Dim i As Integer, nurDatei As String Application.ScreenUpdating = False Set WB1 = ThisWorkbook ChDrive "T:" ChDir "T:\~Betrieb_Waghäusel\~Kommissionierung\~GL Kommissionierung\Allgemein\ _ Parametereinstellungen\" varDatei = Application.GetOpenFilename("Excel Datei (*.xlsm), *.xlsm", , "Datei auswählen", , _ False) 'If varDatei False Then ' Set WB2 = Workbooks.Open(varDatei) 'Else ' Exit Sub 'End If If varDatei False Then 'Position letztes '\' im Pfad+Dateiname ermitteln i = InStrRev(varDatei, "\", -1, vbTextCompare) 'nur den Dateinames rausfiltern nurDatei = Mid(varDatei, i + 1) On Error Resume Next 'Testöffnung Set WB2 = Workbooks(nurDatei) On Error GoTo 0 If WB2 Is Nothing Then Set WB2 = Workbooks.Open(varDatei) Else MsgBox "AM '" & nurDatei & "' ist schön geöffnet!", vbSystemModal + 48, "Hinweis..." End If Else Exit Sub End If WB2.Worksheets(2).Range("M2:S43").Copy WB1.Worksheets(2).Range("M2") WB2.Close SaveChanges:=False Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Prüfen ob Datei bereits geöffnet

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Prüfen ob Datei bereits geöffnet

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread