Schreibschutz auf Ordner enfernen

Bild

Betrifft: Schreibschutz auf Ordner enfernen
von: Holger S.
Geschrieben am: 16.11.2003 08:11:07

Hallo zusammen,
ich habe einen Ordner in dem ich Excel und Word Dokumente habe,
weil meine Kollegen auch auf diese zugreifen, habe ich sie mit einem
Schreibschutz in den Eigenschaften versehen.
Wenn ich nun änderungen an den Dokumenten vorgenommen habe, muss ich erst
Das Dokkument mit einem rechtsklick unter Eigenschaften den Schreinschutz
entfernen.Da es einige Dateien sind möchte ich über ein Makro den Schreibschutz
von allen Dokumenten in dem Ordner entfernen und hinterher, wenn ich meine änderungen vorgenommen habe, wieder alle mit einem Schreibschutz versehen.
Kann mir einer sagen ob es überhaupt möglich ist, über ein Makro den Schreibschutz von einem Ordner zu entfernen, wenn ja wie sieht das Makro aus.

VIELEN DANK SCHON MAL IM VORAUS

Holger S.

Bild


Betrifft: AW: Schreibschutz auf Ordner enfernen
von: Nepumuk
Geschrieben am: 16.11.2003 08:57:17

Hallo Hoger,
den Pfad musst du natürlich noch anpassen.

Option Explicit
Public Sub Schreibschutz_setzen()
    Dim myFsyObjekt As Object, myFObjekt As Object, intIndex As Long
    Set myFsyObjekt = CreateObject("Scripting.FileSystemObject")
    With Application.FileSearch
        .LookIn = "D:\Eigene Dateien\Eigene Tabellen\"
        .Filename = "*.*"
        .Execute
        For intIndex = 1 To .FoundFiles.Count
            Set myFObjekt = myFsyObjekt.GetFile(.FoundFiles(intIndex))
            If myFObjekt.Attributes And Not 1 Then myFObjekt.Attributes = myFObjekt.Attributes + 1
        Next
    End With
End Sub
Public Sub Schreibschutz_loeschen()
    Dim myFsyObjekt As Object, myFObjekt As Object, intIndex As Long
    Set myFsyObjekt = CreateObject("Scripting.FileSystemObject")
    With Application.FileSearch
        .LookIn = "D:\Eigene Dateien\Eigene Tabellen\"
        .Filename = "*.*"
        .Execute
        For intIndex = 1 To .FoundFiles.Count
            Set myFObjekt = myFsyObjekt.GetFile(.FoundFiles(intIndex))
            If myFObjekt.Attributes And 1 Then myFObjekt.Attributes = myFObjekt.Attributes - 1
        Next
    End With
End Sub


Code eingefügt mit: Excel Code Jeanie

Gruß
Nepumuk


Bild


Betrifft: AW: Danke Nepumuk
von: Holger S.
Geschrieben am: 16.11.2003 10:18:21

Hallo Nepumuk
Danke für Deine Mühen.
Code läuft super.

Holger S.


Bild

Beiträge aus den Excel-Beispielen zum Thema " Schreibschutz auf Ordner enfernen"