AW: Exceldateinen in Verzeichnis prüfen ob geöffnet
04.06.2010 21:30:19
Josef
Hallo Timo,
eine Möglichkeit.
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Public Enum XL_FILESTATUS
XL_UNDEFINED = -1
XL_CLOSED
XL_OPEN
XL_DONTEXIST
End Enum
Public Function FileStatus(xlFile As String) As XL_FILESTATUS
On Error Resume Next
Dim File%: File = FreeFile
Err.Clear
Open xlFile For Input Access Read Lock Read As #File
Close #File
Select Case Err.Number
Case 0: FileStatus = XL_CLOSED
Case 70: FileStatus = XL_OPEN
Case 76: FileStatus = XL_DONTEXIST
Case Else: FileStatus = XL_UNDEFINED
End Select
End Function
Sub checkFiles()
Dim strPath As String, strFile As String
Dim strFileList(2) As String, strMsg As String
Dim vntRet As Variant
'Die zu prüfenden Dateien - Anpassen!
strFileList(0) = "Datei1.xls"
strFileList(1) = "Datei2.xls"
strFileList(2) = "Datei3.xls"
strPath = "C:\DeinOrdner" 'Zu prüfendes Verzeichnis - Anpassen!
strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
strFile = Dir(strPath & "*.xls*")
Do While strFile <> ""
vntRet = Application.Match(strFile, strFileList, 0)
If IsNumeric(vntRet) Then
If FileStatus(strPath & strFile) = XL_OPEN Then
strMsg = strMsg & strFile & vbLf & vbTab
End If
End If
strFile = Dir
Loop
If Len(strMsg) Then
MsgBox "Folgende Dateien sind zur Zeit in gebrauch!" & vbLf & vbLf & _
vbTab & strMsg, vbInformation, "CheckFiles"
Else
MsgBox "Alle Dateien sind zur Zeit geschlossen!", vbInformation, "CheckFiles"
End If
End Sub
Gruß Sepp