Gruppe
Datei
Problem
Wie kann ich alle Ordner eines anzugebenden Verzeichnisses in eine UserForm-ComboBox und zugehörige Dateien in eine ListBox übernehmen?
StandardModule: basMain
Sub DialogAufruf()
frmFiles.Show
End Sub
ClassModule: frmFiles
Private Sub cboFolders_Change()
Dim fs As FileSearch
Dim iCounter As Integer
lstFiles.Clear
Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = Range("B1").Value & cboFolders.Value
.FileType = msoFileTypeExcelWorkbooks
.Execute
For iCounter = 1 To .FoundFiles.Count
lstFiles.AddItem .FoundFiles(iCounter)
Next iCounter
End With
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
End Sub
Private Sub cmdOpen_Click()
If lstFiles.Value <> "" Then
Workbooks.Open lstFiles.Value
End If
End Sub
Private Sub UserForm_Initialize()
Dim iCounter As Integer
Dim sDir As String, sFile As String
If Right(Range("B1").Value, 1) <> "\" Then
Range("B1").Value = Range("B1").Value & "\"
End If
sDir = Range("B1").Value
Me.Caption = "Start: " & sDir
sFile = Dir(sDir & "*.*", vbDirectory)
Do While sFile <> ""
If sFile = "." Or sFile = ".." Then
ElseIf (GetAttr(sDir & sFile) And _
vbDirectory) = vbDirectory Then
cboFolders.AddItem sFile
End If
sFile = Dir
Loop
With Application.FileSearch
.LookIn = sDir
.FileType = msoFileTypeExcelWorkbooks
.Execute
For iCounter = 1 To .FoundFiles.Count
lstFiles.AddItem .FoundFiles(iCounter)
Next iCounter
End With
End Sub