Const fsoTotal = 0
   Const fsoFile = 1
   Const fsoExtension = 2
   Const fsoBase = 3
   Const fsoFolder = 4
 
Public Enum FsoReturnTyp
   fsoTotalName = fsoTotal
   fsoFileName = fsoFile
   fsoExtensionName = fsoExtension
   fsoBaseName = fsoBase
   fsoParentFolderName = fsoFolder
End Enum
 
Public Function DateiDialog(ByVal Titel As String, _
                            Optional ByVal DialogTyp As MsoFileDialogType = _
                            msoFileDialogFilePicker, _
                            Optional ByVal ViewTyp As MsoFileDialogView = _
                            msoFileDialogViewDetails, _
                            Optional ByVal MultiAusw As Boolean = False, _
                            Optional ByVal FilterList As String = "alle Dateien" & _
                            "(*.*),*.*", _
                            Optional ByVal InitPfad As String = "C:\", _
                            Optional ByVal ReturnTyp As FsoReturnTyp = _
                            fsoTotalName, _
                            Optional ByVal Delimiter As String = ";") As String
 
   Dim oFileDialog            As FileDialog
   Dim oFso                   As Object
   Dim vFilter                As Variant
   Dim nI                     As Integer
   Dim vItem                  As Variant
 
   Set oFileDialog = Application.FileDialog(DialogTyp)
   DateiDialog = ""
   With oFileDialog
      .Title = Titel
      .ButtonName = "Ok"
      .AllowMultiSelect = MultiAusw
      .Filters.Clear
      If DialogTyp = msoFileDialogFilePicker Then
         vFilter = Split(FilterList, ",")
         If (UBound(vFilter) + 1) Mod 2 > 0 Then
            DateiDialog = "" 
            Exit Function
         End If
         For nI = 0 To UBound(vFilter) Step 2
            .Filters.Add vFilter(nI), vFilter(nI + 1)             
         Next nI
         .FilterIndex = 1
      ElseIf DialogTyp = msoFileDialogFolderPicker And _
             Right(InitPfad, 1) = "\" Then
         InitPfad = Left(InitPfad, Len(InitPfad) - 1)
      ElseIf DialogTyp = msoFileDialogOpen Or _
             DialogTyp = msoFileDialogSaveAs Then
         MsgBox "Das Öffnen und Speichern von Dateien ist" & vbCrLf & _
                "in dieser Funktion nicht implementiert!", _
                vbInformation, _
                "Bedienhinweis" 
         Exit Function
      End If
      .InitialView = ViewTyp
 
      If .Show = True Then
         Set oFso = CreateObject("Scripting.FileSystemObject")
         For Each vItem In .SelectedItems
            Select Case ReturnTyp
               Case Is = fsoTotalName
                  DateiDialog = DateiDialog & Delimiter & vItem
               Case Is = fsoFileName
                  DateiDialog = DateiDialog & Delimiter & oFso.GetFileName( _
                    vItem)
               Case Is = fsoExtensionName
                  DateiDialog = DateiDialog & Delimiter & oFso.GetExtensionName( _
                    vItem)
               Case Is = fsoBaseName
                  DateiDialog = DateiDialog & Delimiter & oFso.GetBaseName( _
                    vItem)
               Case Is = fsoParentFolderName
                  DateiDialog = DateiDialog & Delimiter & _
                    oFso.GetParentFolderName(vItem) & "\"
            End Select
         Next vItem
         DateiDialog = Mid(DateiDialog, 2)
      End If
   End With
   Set oFileDialog = Nothing
 
End Function