Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Ordnerdialog mit nachfolgendem Dateidialog aufrufen

Gruppe

Dialog

Problem

Wie kann ich zuerst einen Dialog zur Auswahl eines Verzeichnisses und danach zur Auswahl einer Excel-Datei aus diesem Verzeichnis aufrufen?

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

ClassModule: frmDateiListe

Private Sub cmdWeiter_Click()
  Unload Me
End Sub

Private Sub UserForm_Initialize()
   Dim iCounter As Integer
   Dim sOrdner As String
   sOrdner = GetDirectory("Ein Verzeichnis auswählen!")
   If sOrdner = "" Then
      Unload Me
   Else
      Me.Caption = "Verzeichnis: " & sOrdner
      With Application.FileSearch
         .LookIn = sOrdner
         .FileType = msoFileTypeExcelWorkbooks
         .Execute
         For iCounter = 1 To .FoundFiles.Count
            lstFiles.AddItem .FoundFiles(iCounter)
         Next iCounter
      End With
  End If
End Sub

StandardModule: basMain

Public Type BROWSEINFO
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" _
   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg As String) As String
   Dim bInfo As BROWSEINFO
   Dim Path As String
   Dim r As Long, x As Long, pos As Integer
   bInfo.pidlRoot = 0&
   If IsMissing(Msg) Then
      bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
   Else
      bInfo.lpszTitle = Msg
   End If
   bInfo.ulFlags = &H1
   x = SHBrowseForFolder(bInfo)
   Path = Space$(512)
   r = SHGetPathFromIDList(ByVal x, ByVal Path)
   If r Then
      pos = InStr(Path, Chr$(0))
      GetDirectory = Left(Path, pos - 1)
   Else
      GetDirectory = ""
   End If
End Function

Sub DialogAufruf()
   frmDateiListe.Show
End Sub