Marko für alle Dateien aus einer Liste ausführen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub PW_EX() Workbooks.Open 'hier brauche ich den Loop, für den ich zu doof bin für alle Dateiennamen _ aus den Zellen a2 bis a301', Password:="xxx" Application.DisplayAlerts = False ActiveWorkbook.SaveAs ActiveWorkbook.Name, Password:="" Application.DisplayAlerts = True ActiveWorkbook.Close savechanges:=False End Sub

Hallo,
kannst mal diesen Code testen.
In der Statusbar kannst Du den verlauf verfolgen.
Am Schluss wird evtl. eine Fehlerliste ausgegeben,
zBsp. bei Schreibschutz wenn Datei verwendet wird oder die Datei nicht vorhanden ist.

Sub PW_EX()
Dim ArPath
Dim ExApp As Excel.Application
Dim n&, nMax&
Dim ArFehler(), i%

Const OeffnenKennwort$ = "xxx"
Const SchreibKennwort$ = ""

ArPath = Range("A2:B301")
Redim Preserve ArPath(1 To Ubound(ArPath), 1 To 1)

Set ExApp = New Excel.Application
ExApp.DisplayAlerts = False
ExApp.ScreenUpdating = False
ExApp.EnableEvents = False

nMax = Ubound(ArPath)
For n = 1 To nMax
    Application.StatusBar = "Bearbeite Datei " & n & " von " & nMax
    If ArPath(n, 1) <> "" Then
        If Dir(ArPath(n, 1), vbNormal) <> "" Then
            With ExApp.Workbooks.Open(Filename:=ArPath(n, 1), Password:=OeffnenKennwort, writeResPassword:=SchreibKennwort)
                If Not .ReadOnly Then
                  .Password = ""
                  .WritePassword = ""
                  .Close savechanges:=True
                Else
                    Redim Preserve ArFehler(i)
                    ArFehler(i) = .Name & " = 'Schreibgeschützt'"
                    i = i + 1
                    .Close savechanges:=False
                End If
            End With
        Else
            Redim Preserve ArFehler(i)
            ArFehler(i) = Right$(ArPath(n, 1), Len(ArPath(n, 1)) - _
                          InStrRev(ArPath(n, 1), "\")) & " = 'nicht gefunden'"
            i = i + 1
        End If
    End If
Next n
ExApp.Quit
Set ExApp = Nothing
Application.StatusBar = False

If i > 0 Then
    MsgBox Join(ArFehler, vbCr), vbCritical, "Fehler"
End If
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Marko für alle Dateien aus einer Liste ausführen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

129 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Marko für alle Dateien aus einer Liste ausführen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

129 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread