Function
txtsuchen()
Dim
suche
Dim
i
As
Long
Dim
quelle
As
String
quelle = ordner(ordner(0) + 1)
ordner(0) = ordner(0) + 1
ChDrive (Left(quelle & "\", 3))
ChDir (quelle)
suche = Dir(quelle &
"\*.*"
, vbDirectory)
Do
Until
suche =
""
msgbox suche
If
(GetAttr(quelle & "\" & suche) = 16)
Then
If
Left(suche, 1) <>
"."
Then
ReDim
Preserve
ordner(UBound(ordner) + 1)
ordner(UBound(ordner)) = quelle & "\" & suche
End
If
Else
If
Right(suche, 4) =
".xls"
Then
If
(Len(suche) <> Len(Replace(suche,
"_Planung"
,
""
))
Or
Len(suche) <> Len(Replace(suche,
"_planung"
,
""
))
Or
Len(suche) <> Len(Replace(suche,
"_PLANUNG"
,
""
)))
And
Len(suche) <> Len(Replace(suche,
"2016"
,
""
))
Then
dateien(0) = dateien(0) + 1
ReDim
Preserve
dateien(dateien(0))
dateien(dateien(0)) = quelle & "\" & suche
End
If
End
If
End
If
suche = Dir()
Loop
End
Function