Option Explicit
' --------------------------------------------------------- 
' Änderungs-History: 
' --------------------------------------------------------- 
' --------------------------------------------------------- 
' Funktion: CountAll 
' Eingestellt von: Andre Schau 
' Datum: 5. Juno 2006 
' Kommentar: Extension wid als beliebiger Substring gewertet 
' Parameter: Pfad :\\und Typ *. 
' Rückgabe: Erfolg: Anzahl, sonst Anzahl und Err.Number 
' Aufruf: 
Sub CountFiles()
'Dateien Oeffnen, Zaehlen und Ausgabe Rueckgabewert 
MsgBox CountAll("C:\Test\", "*.xls") ',True 
End Sub
' --------------------------------------------------------- 
Option Explicit
Private Function CountAll(ByVal strPath$, ByVal sType$, _
        Optional ByVal boOpen As Boolean) As String
'Variablendeklarationen 
'String 
Dim strFile$
'Integer 
Dim iCnt%
'Bei Fehler zu Fehlerbehandlung gehen 
On Error GoTo errorhandler
'Einträge mit Dir auslesen 
strFile = Dir(strPath$ & sType)
'Schleife über alle Einträge 
Do While strFile <> ""
  'Counter hochzählen 
  iCnt = iCnt + 1
  'Wenn Oeffnen True, dann Datei Oeffnen 
  If boOpen Then Workbooks.Open (strPath & strFile)
  'Naechsten Eintrag mit Dir auslesen 
  strFile = Dir(strPath$ & sType)
'Ende Schleife über alle Einträge 
Loop
'Rueckgabewert Anzahl Dateien zuweisen 
CountAll = iCnt
'Funktion verlassen 
Exit Function
'Fehlerbehandlung 
errorhandler:
'Rueckgabewert Anzahl Dateien und Fehlernummer zuweisen 
CountAll = iCnt & "," & Err.Number
End Function