Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.10.2025 09:22:50
Filter aktualisieren bei Blattaufruf
24.10.2025 09:06:52
Zählenwenn
23.10.2025 22:02:44
Warum NV bei meiner Rang Formel?
23.10.2025 20:59:30
Buchstaben aus Zelle auftrennen
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1360to1364
1360to1364
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Abfrage ob Dateien geöffnet sind

Forumthread: Abfrage ob Dateien geöffnet sind

Abfrage ob Dateien geöffnet sind
28.05.2014 11:40:55
Christian
Hallo zusammen,
ich habe 60 Dateien die auf einem Netzlaufwerk liegen und von 60 Personen bearbeitet werden. Mit diesem Code kann ich die entsprechenden Inhalte der Dateien löschen. Das geht aber nur wenn keiner die Liste geöffnet hat.
Jetzt benötige ich eine Abfrage im Code, der prüft ob alle 60 Dateien "Geschlossen" sind und
-falls ja, dann den u.g.Code ausführt
-falls nein, eine MsgBox anzeigen, dass etwas geöffnet ist und keine der Inhalte in allen Dateien löscht, sozusagen den gesamten Löschvorgang im Vorfeld abbricht.
Toll wäre es auch wenn in der MessageBox der entsprechende Dateiname oder auch ggf. mehrere aufgeführt werden.

Private Sub Loeschen_Click()
Dim TB1, TB2, i%, j%
Dim Pfad$, Datname$, Ext$
Application.ScreenUpdating = False
'*** Stammdaten Anfang
Set TB1 = ActiveSheet
Pfad = "T:\Listenordner\"
Ext = ".xlsm"
'*** Stammdaten Ende
For i = 1 To 30
Datname = "Team Meier" & i & Ext
Workbooks.Open Filename:=Pfad & Datname
Set TB2 = Workbooks(Datname).Sheets(1)
TB2.Range("E3").ClearContents
TB2.Range("E5").ClearContents
TB2.Range("E7").ClearContents
TB2.Range("D9").ClearContents
TB2.Range("D11").ClearContents
TB2.Range("D13").ClearContents
TB2.Range("D15").ClearContents
TB2.Range("D17").ClearContents
TB2.Range("D19").ClearContents
TB2.Range("H9").ClearContents
TB2.Range("H11").ClearContents
TB2.Range("H13").ClearContents
TB2.Range("H15").ClearContents
TB2.Range("H17").ClearContents
TB2.Range("H19").ClearContents
Workbooks(Datname).Close savechanges:=True
Next i
For i = 1 To 30
Datname = "Team Schulz" & i & Ext
Workbooks.Open Filename:=Pfad & Datname
Set TB2 = Workbooks(Datname).Sheets(1)
TB2.Range("E3").ClearContents
TB2.Range("E5").ClearContents
TB2.Range("E7").ClearContents
TB2.Range("D9").ClearContents
TB2.Range("D11").ClearContents
TB2.Range("D13").ClearContents
TB2.Range("D15").ClearContents
TB2.Range("D17").ClearContents
TB2.Range("D19").ClearContents
TB2.Range("H9").ClearContents
TB2.Range("H11").ClearContents
TB2.Range("H13").ClearContents
TB2.Range("H15").ClearContents
TB2.Range("H17").ClearContents
TB2.Range("H19").ClearContents
Workbooks(Datname).Close savechanges:=True
Next i
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Abfrage ob Dateien geöffnet sind
28.05.2014 12:12:36
Rudi
Hallo, 
Private Sub Loeschen_Click()
Dim objFiles As Object
Dim TB1, TB2, i%, j%
Dim Pfad$, Datname$, Ext$
Application.ScreenUpdating = False
Set objFiles = CreateObject("Scripting.dictionary")
'*** Stammdaten Anfang
Set TB1 = ActiveSheet
Pfad = "T:\Listenordner\"
Ext = ".xlsm"
'*** Stammdaten Ende
For i = 1 To 30
If IsFileOpen(Pfad & "Team Meier" & i & Ext) Then
objFiles(Datname) = 0
End If
Next
For i = 1 To 30
If IsFileOpen(Pfad & "Team Schulz" & i & Ext) Then
objFiles(Datname) = 0
End If
Next
If objFiles.Count Then
MsgBox "Geöffnete Files:" & vbCrLf & Join(objFiles.keys, vbLf)
Else
For i = 1 To 30
Datname = "Team Meier" & i & Ext
Workbooks.Open Filename:=Pfad & Datname
Set TB2 = Workbooks(Datname).Sheets(1)
TB2.Range("E3").ClearContents
TB2.Range("E5").ClearContents
TB2.Range("E7").ClearContents
TB2.Range("D9").ClearContents
TB2.Range("D11").ClearContents
TB2.Range("D13").ClearContents
TB2.Range("D15").ClearContents
TB2.Range("D17").ClearContents
TB2.Range("D19").ClearContents
TB2.Range("H9").ClearContents
TB2.Range("H11").ClearContents
TB2.Range("H13").ClearContents
TB2.Range("H15").ClearContents
TB2.Range("H17").ClearContents
TB2.Range("H19").ClearContents
Workbooks(Datname).Close savechanges:=True
Next i
For i = 1 To 30
Datname = "Team Schulz" & i & Ext
Workbooks.Open Filename:=Pfad & Datname
Set TB2 = Workbooks(Datname).Sheets(1)
TB2.Range("E3").ClearContents
TB2.Range("E5").ClearContents
TB2.Range("E7").ClearContents
TB2.Range("D9").ClearContents
TB2.Range("D11").ClearContents
TB2.Range("D13").ClearContents
TB2.Range("D15").ClearContents
TB2.Range("D17").ClearContents
TB2.Range("D19").ClearContents
TB2.Range("H9").ClearContents
TB2.Range("H11").ClearContents
TB2.Range("H13").ClearContents
TB2.Range("H15").ClearContents
TB2.Range("H17").ClearContents
TB2.Range("H19").ClearContents
Workbooks(Datname).Close savechanges:=True
Next i
End If
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub
Function IsFileOpen(strFullPathFileName As String) As Boolean
'// VBA version to check if File is Open
'// We can use this for ANY FILE not just Excel!
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim hdlFile As Long
'// Error is generated if you try
'// opening a File for ReadWrite lock >> MUST BE OPEN!
On Error GoTo FileIsOpen:
hdlFile = FreeFile
Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
IsFileOpen = False
Close hdlFile
Exit Function
FileIsOpen:
'// Someone has it open!
IsFileOpen = True
Close hdlFile
End Function

Gruß
Rudi
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige