Pfad in einem Makro ändern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Pfad in einem Makro ändern
von: parza
Geschrieben am: 28.11.2015 11:35:10

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

Bild

Betrifft: AW: Pfad in einem Makro ändern
von: Matthias
Geschrieben am: 28.11.2015 11:56:20
Hallo Parza,
das würde so funktionieren:

Dim objShell As Object, objFolder As Object
Const strStartPath As String = "D:\Eigene Dateien" '
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0&, "Ordner wählen", _
        &H4000, strStartPath)
If Not objFolder Is Nothing Then
  strPath = objFolder.Self.Path
Else
    ' deine Aktionen wenn Abbrechen gewählt
    ' ...
End If
Dies ersetzt dann deine Zeile "strPath = "E:\Forum" 'Verzeichnis - Anpassen!".
lg Matthias

Bild

Betrifft: AW: Pfad in einem Makro ändern
von: Hajo_Zi
Geschrieben am: 28.11.2015 11:58:01


Function GetAOrdner2() As String
    If BoFehler Then On Error GoTo Errorhandler1
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            GetAOrdner2 = .SelectedItems(1) & "\"
        Else
            GetAOrdner2 = ""
        End If
    End With
    Exit Function
'Errorhandler1:
'    Fehlerbehandlung 1, 167
End Function
Sub Start()
    MsgBox GetAOrdner2
End Sub


Bild

Betrifft: AW: Pfad in einem Makro ändern
von: parza
Geschrieben am: 29.11.2015 09:39:08
Super, vielen Dank.
Ist deine Lösung bei jedem Makro anwendbar, bei denen eine entsprechende Pfadeingabe gewünscht ist?

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Pfad in einem Makro ändern"