AW: Schreibschutzprüfung
12.10.2005 11:57:55
Heiko
Hallo Eres,
noch ein Versuch, mit der Voraussetzung das alle das gleiche Passwort haben. Wenn das nicht der Fall ist, müsstest du in diese Zeile
Workbooks.Open Filename:=.FoundFiles(lngI), WriteResPassword:="Test"
so ändern,
Workbooks.Open Filename:=.FoundFiles(lngI)
Was aber leider zur Folge hat das du dann bei Mappen mit Passwort dazu aufgefordert wirst dieses einzugeben.
Wenn das nicht reicht musst du die Frage wieder offen stellen, da ich dann auch nicht mehr helfen kann.
Sub SchreibSchutz()
Dim bolStatus As Boolean
Dim strFolder As String
Dim lngI As Long, lngHelp As Long
' Verzeichnis apassen !!!
strFolder = "C:\Copy"
ChDrive Left(strFolder, 2)
ChDir strFolder
With Application.FileSearch
.NewSearch
.LookIn = strFolder
' Wenn Unterordner nicht durchsucht werden sollen dann hier False angeben.
.SearchSubFolders = True
.Filename = "*.xls"
.Execute
If .FoundFiles.Count = 0 Then
MsgBox "Im angegebenen Laufwerk wurden keine EXCEL Dateien gefunden !", vbInformation
Exit Sub
End If
ActiveSheet.Cells.Delete
ActiveSheet.Cells(1, 1) = "Schreibschutz"
ActiveSheet.Cells(1, 2) = "Pfad + Datei"
lngHelp = 2
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
For lngI = 1 To .FoundFiles.Count
Application.StatusBar = "Datei " & lngI & " von " & .FoundFiles.Count & ". " & .FoundFiles(lngI) & " wird bearbeitet"
' Wenn alle das gleiche Passwort haben, dann geht das so.
' Wenn nicht dann habe ich keine weitere Lösung.
Workbooks.Open Filename:=.FoundFiles(lngI), WriteResPassword:="Test"
bolStatus = ActiveWorkbook.WriteReserved
MsgBox bolStatus
ActiveWorkbook.Close
If bolStatus = False Then
ActiveSheet.Cells(lngHelp, 1) = bolStatus
ActiveSheet.Cells(lngHelp, 2) = .FoundFiles(lngI)
lngHelp = lngHelp + 1
End If
Application.StatusBar = False
Next lngI
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
MsgBox "Fertig !", vbInformation
End Sub
Gruß Heiko
PS: Rückmeldung wäre nett !