geschützte Dokumente filtern?

[Huddel]

da sowieso keiner in das unterforum "Scripting & Programmieren" reinschaut, und ich nicht ewig auf eine antwort warten will schreib ichs hier rein.

mein problem,

ich soll aus einem ordner mit beliebig vielen unterordnern, alle worddatein darauf prüfen ob sie einen dokumentschutz haben. also keinen Schreibschutz, nur den dokumentschutz (bei formularen). kann mir da einer weiterhelfen, bzw. ob es mit einem makro geht oder ob es auch anders geht? wollte es gern automatisieren, da es über 30000 worddokumente sind.

danke

huddel

 

[Huddel]

hab mal selber ein bisschen gegooglet, und das gefunden

damit kann man den dokumentschutz aufheben, das problem dabei ist, das er bei den dokumenten, die keinen schutz haben, den schutz aktiviert.

Sub FormularschutzDynamischAufheben()
     If ActiveDocument.ProtectionType >= 0 Then
       ActiveDocument.Unprotect
   Else
       ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
      End If
    End Sub

und hiermit kann man eine komplette ordnerstruktur durchsuchen, und etwas ersetzen (brauche aber nur das durchsuchen der ordnerstruktur, mit dem dokumentschutz aufheben)

' **** Anpassbare Werte ****
Private Const Verzeichnis = "C:\Eigene Dateien"
Private Const Filter = "*.doc"
Private Const UnterverzeichnisseDurchsuchen = 0
Private Const Suche = "Felix Muster"
Private Const ErsetzeMit = "Felix Muster"
' **** Ende der Anpassung ****

Private Teil As Range

Sub SuchenErsetzenGanzesVerzeichnis()
  Dim oDoc As Document
  tmp = UnterverzeichnisseDurchsuchen
  If tmp = 1 Then UVD = True Else UVD = False
  If Documents.Count > 0 Then Dokument = ActiveDocument.FullName
  With Application.FileSearch
    .LookIn = Verzeichnis
    .FileName = Filter
    .SearchSubFolders = UVD
    .Execute SortBy:=msoSortByFileName
    Anzahl = .FoundFiles.Count
    Application.ScreenUpdating = False
    For Each aDok In .FoundFiles
      If aDok <> Dokument Then
        On Error Resume Next
        Documents.Open aDok
        Fehler = Err.Number
        On Error GoTo 0
        If Fehler = 0 Then
          Set oDoc = ActiveDocument
          If oDoc.ProtectionType = wdNoProtection Then
            If oDoc.ReadOnly = False Then
              StatusBar = "Durchsuche Dokument " + aDok + "."
              DoEvents
              SuchenErsetzenSchleife
              oDoc.Close SaveChanges:=wdSaveChanges
            Else
              oDoc.Close SaveChanges:=wdDoNotSaveChanges
            End If
            Else
            oDoc.Close SaveChanges:=wdDoNotSaveChanges
          End If
        End If
      End If
    Next
  End With
  StatusBar = CStr(Anzahl) + " Dokumente durchsucht."
  DoEvents
  Application.ScreenUpdating = True
End Sub

Private Sub SuchenErsetzenSchleife()
  Application.ScreenUpdating = False
  For Each Teil In ActiveDocument.StoryRanges
    SuchenErsetzen
    While Not (Teil.NextStoryRange Is Nothing)
      Set Teil = Teil.NextStoryRange
      SuchenErsetzen
    Wend
  Next
End Sub

Private Sub SuchenErsetzen()
  Teil.Find.Execute FindText:=Suche, _
    ReplaceWith:=ErsetzeMit, _
    MatchCase:=GrossUndKleinSchreibung, _
    MatchWholeWord:=GanzesWort, _
    MatchWildcards:=Jocker, _
    Replace:=wdReplaceAll
End Sub

währe nett, wenn da mal jemand was zusammenbasteln kann, hab keine ahnung wo ich da anfangen soll.

schonmal danke