Hallo Souffleurlos,
die von Dir empfohlene Application-Eigenschaft DIALOGS ist doch ziemlich aufwendig zu verwenden. Ich habe mich denn doch für die Application-Eigenschaft FILEDIALOG entschieden. Vorallem, weil ich die gesuchte Datei nicht unmmittelbar aus dem Dialog heraus öffnen wollte. Mit FILEDIALOG geht es sehr schön.
Ich habe mir dazu eine kleine Funktion geschrieben, die ich anderen Interessierten zur Nachnutzung bereitstellen möchte:
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 Ich mußte leider alle meine Kommentare entfernen, um im Meldungslimit zu bleiben.
Gruß, Rainer. |