VBA-Beispiel 025
mail schreiben
mail schreiben

mit VBA Schreibschutz entfernen
Wenn Sie Dateien vom CD-Rom Laufwerk auf Festplatte speichern, sind die Dateien schreibgeschützt. Um diesen Schreibschutz aufzuheben müssen sie im Explorer jede Datei einzeln anklicken und bei den Dateieigenschaften den Schreibschutz entfernen.

Das Makro unten erleichtert diese Angelegenheit:
Es wird für alle Dateien im abgefragten Ordner der Schreibschutz aufgehoben (egal welcher Dateityp).

Nicht verändert wird der Excel interne Lese/Schreibschutz.
Sub Schreibschutz_weg()
'entfernt den (Explorer-) Schreibschutz aller Dateien
'im abgefragten Ordner
Dim Pfad As String
Dim i As Integer
Dim fs

If Val(Application.Version) > 11 Then
  MsgBox "Dieses Makro funktioniert nur bis einschl. Excel 11.0" _
    & vbNewLine & _
    "Sie haben aber Excel: " & Application.Version _
    & vbNewLine & vbNewLine _
    & "keine Änderungen durchgeführt", , "Abbruch"
  Exit Sub
End If

Set fs = Application.FileSearch

Pfad = InputBox("Geben Sie den Pfad ein", , _
                "C:\Eigene Dateien\Test")
If Pfad = "" Then Exit Sub

With fs
    .LookIn = Pfad
    .Filename = "*.*"
  'wenn der Pfad nicht existiert Programm abbrechen
   If Dir(Pfad, vbDirectory) = "" Then
      MsgBox "Falsche Pfadangabe!  Das Verzeichnis" & _
              vbCrLf & "' " & Pfad & " '" & _
              vbCrLf & "existiert nicht !", _
              vbExclamation, "Fehlermeldung"
        Exit Sub
    End If

    If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
        MsgBox .LookIn & vbNewLine & vbNewLine _
        & "Es wurden " & .FoundFiles.Count & " Dateien gefunden."
        For i = 1 To .FoundFiles.Count
           'MsgBox .FoundFiles(i)
            SetAttr .FoundFiles(i), vbNormal
        Next i
    Else
        MsgBox "Der Ordner ist leer..."
    End If
End With

End Sub
Download:   vba025.zip
relevante Links:

top