Option
Explicit
Dim
mFso
As
Object
Const
m_sPfad
As
String
= "c:\Test\"
Const
m_FileExtension
As
String
=
".XLSM"
Dim
lCalc
As
Long
Dim
lEvent
As
Long
Dim
lStatusbar
As
Long
Dim
lScreen
As
Long
Sub
main()
On
Error
GoTo
FinishErr
Call
TurnOffFunctionality
Set
mFso = CreateObject(
"Scripting.FileSystemObject"
)
Call
OrdnerDurchsuchen(mFso.GetFolder(m_sPfad))
FinishErr:
If
err.Number <> 0
Then
MsgBox err.Number & vbCrLf & err.Description
End
If
Call
TurnOnFunctionality
Set
mFso =
Nothing
End
Sub
Sub
OrdnerDurchsuchen(
ByRef
oFolder
As
Object
)
Dim
oSubFldr
As
Object
Dim
oFile
As
Object
For
Each
oSubFldr
In
oFolder.SubFolders
Call
OrdnerDurchsuchen(oSubFldr)
Next
For
Each
oFile
In
oFolder.Files
If
UCase(Right(oFile.Name, 5)) = m_FileExtension
Then
Debug.Print oFile.Name
End
If
Next
Set
oSubFldr =
Nothing
Set
oFile =
Nothing
End
Sub
Public
Sub
TurnOffFunctionality()
With
Application
lCalc = .Calculation: .Calculation = xlCalculationManual
lStatusbar = .DisplayStatusBar: .DisplayStatusBar =
False
lEvent = .EnableEvents: .EnableEvents =
False
lScreen = .ScreenUpdating: .ScreenUpdating =
False
End
With
End
Sub
Public
Sub
TurnOnFunctionality()
With
Application
.Calculation = lCalc
.DisplayStatusBar = lStatusbar
.EnableEvents = lEvent
.ScreenUpdating = lScreen
End
With
End
Sub