VBA Dokumentenschutz aufheben Suchen Ersetzen Dokument schützen

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

' **** Anpassbare Werte ****  
Private Const Verzeichnis = "C:Eigene Dateien"  
Private Const Filter = "*.doc"  
Private Const UnterverzeichnisseDurchsuchen = 0
Private Const Suche = "XXXXXXXXX"  
Private Const ErsetzeMit = "YYYYYYYYYYY"  
' **** 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

Sub SpeichernAufruf()

    With Dialogs(wdDialogFileSaveAs)

    End With

End Sub

Sub Dokumentenschutz_aufheben()
    Documents.Open FileName:="XXXXX.doc", ConfirmConversions:= _  
        False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _  
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _  
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""  
End Sub

Sub suchen_ersetzen()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "xxxxx"  
        .Replacement.Text = "yyyyy"  
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Sub speichern_unter_97_2003()
    ChangeFileOpenDirectory "D:	est"  
    ActiveDocument.SaveAs FileName:="XXXXX.doc", FileFormat:=100, _  
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _  
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _  
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
End Sub

Sub Dokumentenschutz_aufheben_word2003()
    Documents.Open FileName:="XXXXX.doc", ConfirmConversions:= _  
        False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _  
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _  
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""  
End Sub

Sub Dokumentenschutz_aufheben_word2007()
    ActiveDocument.Unprotect
End Sub

Sub suchen_ersetzen_word2003_2007_identisch()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "xxxxx"  
        .Replacement.Text = "yyyyy"  
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Sub Dokument_schützen_word2007()
    ActiveDocument.Protect Password:="", NoReset:=False, Type:= _  
        wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=False
End Sub

Sub speichern_unter_97_2003_inW2003()
    ChangeFileOpenDirectory "D:	est"  
    ActiveDocument.SaveAs FileName:="XXXXX.doc", FileFormat:=100, _  
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _  
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _  
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
End Sub

Sub speichern_unter_97_2003_inW2007()
    ActiveDocument.SaveAs FileName:="Dok2.doc", FileFormat:=wdFormatDocument, _  
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _  
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _  
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
End Sub

Sub Alle_Dateien_formatieren()
Dim objFileSystemObject As Object
Dim objAnzDateien As Object
Dim objDatei As Object

Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")  
Set objAnzDateien = objFileSystemObject.getfolder("C:Eigene Dateien")  

For Each objDatei In objAnzDateien.Files
   If Right(objDatei.Name, 4) = ".doc" Then  
        
        With 

Hier kommen jetzt die eigentlichen Befehle von oben.

        End With
   End If
Next

Set objFileSystemObject = Nothing
Set objAnzDateien = Nothing
End Sub