Excel und VBA: Formeln, Programmierung, Lösungen

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

    

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