Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1296to1300
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
Inhaltsverzeichnis

Dateizustand- Schreibschutzrecht anzeigen

Dateizustand- Schreibschutzrecht anzeigen
11.02.2013 00:23:15
Peter
Hallo,
wie muss das vorhandene Makro erweitert werden damit der
Schreibschutz angezeigt wird und eventuelle Fehler behandelt werden?
Danke im voraus
Peter
Sub DateiZustand()
Dim Pfad As String, _
iOpen As Byte
Pfad = "D:\Data\AbtA\NutzerB\GrundB\GrunddatenB.xls"
iOpen = DateiIstFrei(Pfad)
Select Case iOpen
Case 0
MsgBox "Datei " & Pfad & " ist frei !"
Case 1
MsgBox "Datei " & Pfad & " ist geöffnet !"
Case 2
MsgBox "Datei " & Pfad & " wurde nicht gefunden !"
End Select
End Sub
Function DateiIstFrei(sDateiname As String) As Byte
If Dir(sDateiname) = "" Then
DateiIstFrei = 2
Else
On Error GoTo ERRORHANDLER
Open sDateiname For Random Access Read Lock Read Write As #1
Close #1
End If
ERRORHANDLER:
If Err = 70 Then DateiIstFrei = 1
End Function

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW:Danke- Schreibschutz prüfen ohne open
12.02.2013 08:10:12
Peter
Danke, genau das habe ich gesucht
Peter
Sub IsFileProtect()
Select Case TestExcelDat("D:\Data\AbtA\NutzerB\GrundB\GrunddatenB.xls")
Case 0: MsgBox "passt"
Case 3161: MsgBox "verschlüsselt"
Case -1: MsgBox "Schreibschutz"
Case -2: MsgBox "Keine Tabellen"
Case Else:  MsgBox "Problem :-("
End Select
End Sub

Function TestExcelDat(ExcelDat As String) As Long
Dim db As Object
On Error Resume Next
If Val(Application.Version) > 11 Then ' ab 2007
Set db = CreateObject("DAO.DBEngine.120").OpenDatabase(ExcelDat, False, False, "Excel 8.0")
Else
Set db = CreateObject("DAO.DBEngine.36").OpenDatabase(ExcelDat, False, False, "Excel 8.0")
End If
If Err.Number  0 Then
TestExcelDat = Err.Number
Err.Clear
Exit Function
End If
On Error GoTo 0
If db.Properties("Updatable") = False Then TestExcelDat = -1
If db.TableDefs.Count = 0 Then TestExcelDat = -2
db.Close
End Function

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige