Gruppe
Datei
Problem
Mit der ersten Schaltfläche sollen die Dateinamen des in Zelle B1 genannten Verzeichnisses gelistet und mit der zweiten die in Spalte B mit einem x gekennzeichneten Arbeitsmappen geöffnet werden.
StandardModule: Modul1
Sub ReadFiles()
Dim iCounter As Integer
With Application.FileSearch
.LookIn = Range("B1").Value
.Filename = "*.xls"
.Execute
For iCounter = 1 To .FoundFiles.Count
Cells(iCounter + 1, 1).Value = Dir(.FoundFiles(iCounter))
Next iCounter
End With
End Sub
Sub OpenFiles()
Dim wks As Worksheet
Dim iRow As Integer
Dim sPath As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wks = ActiveSheet
iRow = 1
sPath = Range("B1").Value
On Error GoTo ERRORHANDLER
Do Until IsEmpty(wks.Cells(iRow, 1))
iRow = iRow + 1
If LCase(wks.Cells(iRow, 2).Value) = "x" Then
Workbooks.Open sPath & "\" & wks.Cells(iRow, 1).Value, False
End If
Loop
ERRORHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub