Passwort per Makro ändern

Sub Passwort_ändern() Application.ScreenUpdating = False Dim sWbName As String, oFS As Object, oDatei As Object, sBereich As String Const sDateiPfad As String = "S:\..." 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash _ _ _ am Ende Set oFS = CreateObject("Scripting.FileSystemObject") For Each oDatei In oFS.GetFolder(sDateiPfad).Files sWbName = oDatei.Name Next Workbooks.Open (sDateiPfad & sWbName), Password:="pw_alt" Workbooks(sWbName).Unprotect (pw_alt) Workbooks(sWbName).Protect (pw_neu) Workbooks(sWbName).Saved = True Workbooks(sWbName).Close Application.ScreenUpdating = False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Vicky,
probier mal so.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Passwort_ändern()
Dim objWB As Workbook
Dim strFile As String, strPath As String
Dim CalculationMode As Long, UpdateLinks As Long

Const strOldPW As String = "altesPasswort"

Const strNewPW As String = "neuePasswort"

strPath = "S:\..."

If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

On Error GoTo ErrorHandler

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  CalculationMode = .Calculation
  .Calculation = xlManual
  UpdateLinks = .AskToUpdateLinks
  .AskToUpdateLinks = False
  .DisplayAlerts = False
End With

strFile = Dir(strPath & "*.xls*", vbNormal)

Do While strFile <> ""
  Set objWB = Workbooks.Open(Filename:=strPath & strFile, UpdateLinks:=False, Password:=strOldPW)
  objWB.SaveAs Filename:=objWB.FullName, Password:=strNewPW
  objWB.Close
  Set objWB = Nothing
  strFile = Dir
Loop

ErrorHandler:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'Passwort_ändern'" & vbLf & String(25, "") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, 81968, "VBA - Fehler in Prozedur - Passwort_ändern", .HelpFile, .HelpContext
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = CalculationMode
  .DisplayAlerts = True
  .AskToUpdateLinks = UpdateLinks
  .CutCopyMode = False
  .StatusBar = False
End With

Set objWB = Nothing
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Passwort per Makro ändern

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread