Pfad in einem Makro ändern
28.11.2015 11:35:10
parza
Hallo, dank eurer Hilfe habe ich ein super funktierendes Excel-Macro um alle Dateien in einem beliebigen Ordner mit Blattschutz zu versehen bzw. aufzuheben. Nun meiner Frage: Bisher muss man den Ort, wo das Makro suchen soll, direkt in den code schreiben. Da ich nicht möchte, das die Mitarbeiter direkt ins Makro schreiben, wäre es schön, wenn man dies über einen Mini-Explorerfenster auswählen könnte und dies direkt ins Makro eingetragen wird. D.h. Der Pfad in strParth soll entsprechend angepasst werden.
Danke parza
Das wäre das Makro
Option Explicit
Sub schutzAus()
Dim objWB As Workbook, objSh As Worksheet
Dim strFile As String, strPath As String
On Error GoTo ErrorHandler
Static CalculationMode As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
strPath = "E:\Forum" 'Verzeichnis - Anpassen!
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.xls", vbNormal)
Do While strFile <> ""
Set objWB = Workbooks.Open(strPath & strFile)
For Each objSh In objWB.Worksheets
objSh.Unprotect
Next
objWB.Close True
strFile = Dir
Loop
ErrorHandler:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'schutzAus'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Prozedur - schutzAus"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
Set objWB = Nothing
Set objSh = Nothing
End Sub
Sub schutzEin()
Dim objWB As Workbook, objSh As Worksheet
Dim strFile As String, strPath As String
On Error GoTo ErrorHandler
Static CalculationMode As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
strPath = "E:\Forum" 'Verzeichnis - Anpassen!
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.xls", vbNormal)
Do While strFile <> ""
Set objWB = Workbooks.Open(strPath & strFile)
For Each objSh In objWB.Worksheets
objSh.Protect
Next
objWB.Close True
strFile = Dir
Loop
ErrorHandler:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'schutzEin'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Prozedur - schutzEin"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
Set objWB = Nothing
Set objSh = Nothing
End Sub