Eine kleine Funktion um einen Ordner auszuwählen

Public Function getFolderDialog(Optional iStartFolder As Variant = false) As Variant

• iStartFolder Gibt den Start-Pfad oder False an.

Der Rückgabewert ist ein String mit dem ausgewählten Ordnerpfad oder False, falls die Auswahl abgebrochen wurde

Normaler Start. Der Startornder wir dem System überlassen

Dim exportFolterPath As String
exportFolterPath = getFolderDialog()
If exportFolterPath then
    //TODO: Export FIle
End If

Und falls man mit der Ordnersuche an einem bestimmten Ort starten will

exportFolterPath = getFolderDialog("C:\temp")

getFolderDialog.bas

'-------------------------------------------------------------------------------
'File         : getFolderDialog
'               Copyright mpl by ERB software
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/getfolderdialog
'Version      : 1.0.0
'Author       : Stefan Erb (ERS)
'History      : 06.06.2013 - 1.0.0 - ERS - Creation
'-------------------------------------------------------------------------------
 
'/**
' * öffnet die Auswahl für Ordner
' * @param  Variant     Ein Initialpfad oder false       
' * @return Varaint     Ein Pfad oder false       
' */
Private Function getFolderDialog(Optional ByVal iStartFolder As Variant = false) As Variant
    Dim fldR As FileDialog
    Dim vItem As Variant
On Error GoTo Err_Handler
 
    getFolderDialog = false
 
    Set fldR = Application.FileDialog(msoFileDialogFolderPicker)
 
    With fldR
        .title = "Select a Folder"
        .AllowMultiSelect = False
        If iStartFolder = -1 Then
            .InitialFileName = "C:\"
        Else
            If Right(iStartFolder, 1) <> "\" Then
                .InitialFileName = iStartFolder & "\"
            Else
                .InitialFileName = iStartFolder
            End If
        End If
        If .show <> -1 Then GoTo Exit_Handler
        getFolderDialog = .SelectedItems(1)
    End With
 
Exit_Handler:
On Error Resume Next
    Set fldR = Nothing
    Exit Function    
Err_Handler:
    Call Err.Raise(Err.Number, "parseFormat." & Err.Source, Err.description, Err.HelpFile, Err.HelpContext)
    Resume Exit_Handler
    Resume
End Function