VBA-Programmierung in Microsoft Excel

Vorkommen eines Wortes in Arbeitsmappen eines Verzeichnisse

StandardModule: basMain

Sub EintraegeZaehlen()
   Dim arr As Variant
   Dim iCounter As Integer, iRow As Integer
   Dim sPath As String
   Application.ScreenUpdating = False
   Application.EnableEvents = True
   On Error GoTo ERRORHANDLER
   sPath = Range("B1").Value
   arr = FileArray(sPath, "*.xls")
   For iCounter = 1 To UBound(arr)
      Workbooks.Open sPath & arr(iCounter), False
      With ThisWorkbook.Worksheets("Import")
         iRow = iRow + 1
         .Cells(iRow, 1) = ActiveWorkbook.Name
         .Cells(iRow, 2) = WorksheetFunction.CountIf(Columns(1), _
            "Apfelsinensaft")
      End With
      ActiveWorkbook.Close savechanges:=False
   Next iCounter
ERRORHANDLER:
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

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 Verzeichnis