AW: Anzeigen, wenn eine andere Excel-Datei ge
15.09.2014 10:24:36
Klaus
Hi Schmitty,
deine zu prüfenden Dateien stehen - inklusive Pfad und Endung - in Spalte A.
Eine Fehlerbehandlung habe ich nicht eingebaut. Der eigentlich interessante Codeteil ist geklaut (Referenz im Makro), von mir stammt nur die Schleife.
Einfärben kannst du per Boardmittel (bedingte Formatierung). Das Makro musst du allerdings manuell anstoßen. Kannst du ja, je nach Bedarf, mit Worksheet.Activate oder so machen.
Sub CheckAllFilesOpen()
Const firstRow As Long = 2 'Ab Zeile 2 (Überschriften)
Const datCol As Long = 1 'Dateien + Pfad stehen in Spalte A
Const putCol As Long = 2 'Info in Spalte B schreiben
Dim lastRow As Long
Dim r As Range
Dim infoText As String
infoText = "Datei geöffnet: "
With ActiveSheet
lastRow = .Cells(.Rows.Count, datCol).End(xlUp).Row
For Each r In .Range(.Cells(firstRow, datCol), .Cells(lastRow, datCol))
.Cells(r.Row, putCol).Value = infoText & IsFileOpen(r.Value)
Next r
End With
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
Grüße,
Klaus M.vdT.