Gruppe
Datei
Problem
Wie kann ich alle Arbeitsmappen eines Verzeichnisses durch das Drücken einer Schaltfläche öffnen?
StandardModule: basMain
Sub DateienOeffnen()
Dim arr As Variant
Dim iCounter As Integer
Dim sPath As String
Dim bln As Boolean
Application.ScreenUpdating = False
bln = Application.DisplayStatusBar
Application.DisplayStatusBar = True
sPath = Range("B1").Value
arr = FileArray(sPath, "*.xls")
For iCounter = 1 To UBound(arr)
Application.StatusBar = "Öffne Datei " & _
arr(iCounter) & "..."
Workbooks.Open sPath & arr(iCounter)
Next iCounter
Application.StatusBar = False
Application.DisplayStatusBar = bln
Application.ScreenUpdating = True
End Sub
Private Function FileArray(sPath As String, sPattern As String)
Dim arrFiles()
Dim iCounter As Integer
Dim sFile As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile = Dir(sPath & sPattern)
Do While sFile <> ""
iCounter = iCounter + 1
ReDim Preserve arrFiles(1 To iCounter)
arrFiles(iCounter) = sFile
sFile = Dir()
Loop
FileArray = arrFiles
End Function