Thema: Ordnerdialog mit nachfolgendem Dateidialog aufrufen

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

Beiträge aus dem Excel-Forum zu den Themen Datei und Dialog