Sub makro_filename()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
MyPath = "irgendeinpfad"
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "Keine Dateien gefunden"
Exit Sub
End If
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open((MyPath & MyFiles(Fnum)), , , , Password:="password")
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
For Each sh In mybook.Worksheets
If sh.ProtectContents = False Then
With sh
.PageSetup.LeftFooter = "Form-Nr. " & mybook.Name
.Range("A7:I11").Interior.Color = RGB(224, 224, 224)
End With
Else
ErrorYes = True
End If
Next sh
If Err.Number > 0 Then
ErrorYes = True
Err.Clear
mybook.Close savechanges:=False
Else
mybook.Close savechanges:=True
End If
On Error GoTo 0
Else
ErrorYes = True
End If
Next Fnum
End If
If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub