Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1360to1364
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
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 Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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

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

Links zu Excel-Dialogen

MessageBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige