Schreibschutz-Info bei öffnen per VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
da gibt es mehrere Möglichkeiten.
Such dir eine aus ;-))

Option Explicit
Sub Check_File_Open()
'by Ramses
'prüft eine Datei auf möglichen Zugriff durch andere Programme
'oder Benutzer.
'Ist die Datei nicht geöffnet, wird eine Sicherungsdatei angelegt
'zur Weiterbearbeitung.
'Diese Sicherungsdatei muss am Ende des Codes wieder gelöscht werden
Dim myFso As Object
Dim FileToOpen As String, FileToCopy As String
Dim openCounter As Byte, Qe As Byte
Set myFso = CreateObject("Scripting.Filesystemobject")
FileToOpen = "C:\Pfad\Daten.txt"
FileToCopy = "C:\Pfad\TempDaten.txt"
openCounter = 0
'Prüfen ob Datei offen ist
ReCheckFile:
If IsFileOpen(FileToOpen) = True Then
    'Es werden insgesamt 3 Öffnungsprozeduren zugelassen
    'bevor abgebrochen wird
    If openCounter = 3 Then
        Qe = MsgBox("Datei konnte nicht geöffnet werden", vbCritical + vbOKOnly, "TimeOut-Fehler")
        Exit Sub
    End If
    '5 Sekunden warten
    Application.Wait (Now + TimeValue("00:00:05"))
    openCounter = openCounter + 1
    GoTo ReCheckFile
End If
'Sicherungsdatei anlegen
myFso.FileCopy FileToOpen, FileToCopy
'Weitere Anweisungen
'----
'Sicherungsdatei löschen
Kill FileToCopy
End Sub
Wird als allgemeine Function verwendet
Public Function IsFileOpen(ByRef path As String) As Boolean
'von Günther Abel
Dim FileNr As Integer
Dim ErrorNr As Long
' Datei testweise öffnen:
On Error Resume Next
'FreeFile ist eine Funktion welche die nächste freie Nummer
'zur Bearbeitung zurückgibt
FileNr = FreeFile
Open path For Input Lock Write As #FileNr
ErrorNr = Err.Number
Close #FileNr
On Error GoTo 0
' Ggf. Fehler verarbeiten:
Select Case ErrorNr
Case 0
    'kein Fehler:
    IsFileOpen = False
Case 70
    'Permission denied':
    IsFileOpen = True
Case Else
    'sonstiger Fehler:
    IsFileOpen = True
    Err.Raise ErrorNr
End Select
End Function
Oder so
'CodeSequenz Start
Sub Check_Local_File_Open()
'ACHTUNG
'Der Vergleich wird mit Gross und Kleinschreibung gemacht
If Is_Open_Local_File("Test.xls") Then
    MsgBox "Schon geöffnet"
Else
    MsgBox ("Noch nicht geöffnet")
End If
End Sub
Gruss Rainer

Beliebteste Forumthreads (12 Monate)

Schreibschutz-Info bei öffnen per VBA

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

176 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Schreibschutz-Info bei öffnen per VBA

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

176 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread