Option
Explicit
Private
fso as
Object
CONST s_TEILBEZEICHNUNG as
String
=
"*aktuell*"
CONST s_LEFT_2_ORDNERNAME
As
String
=
"A-"
Sub
main()
Set
fso = CreateObject(
"Scripting.FileSystemObject"
)
DurchsucheOrdner
"T:\Technische Dokumentation"
End
Sub
Sub
DurchsucheOrdner(
ByVal
sPfad
As
String
)
Dim
fil
As
Object
Dim
subFldrKunde
As
Object
Dim
subFldrArtikel
As
Object
Dim
subFldrDokumente
As
Object
Dim
vDokumentenOrdner
As
Variant
vDokumentenOrdner = Array(
"Arbeitsanweisungen"
,
"Maschineneinstellplan"
,
"Verpackungsvorschriften"
)
For
Each
subFldrKunde
In
fso.GetFolder(sPfad).SubFolders
If
(Len(subFldrKunde.ShortName) = 3)
Or
(Left(UCase(subFldrKunde.ShortName), 2) = s_LEFT_2_ORDNERNAME)
Then
For
Each
subFldrArtikel
In
fso.GetFolder(subFldrKunde).SubFolders
If
(Left(UCase(subFldrArtikel.ShortName), 2) = s_LEFT_2_ORDNERNAME)
Then
For
Each
subFldrDokumente
In
fso.GetFolder(subFldrArtikel).SubFolders
If
UBound(Filter(vDokumentenOrdner, subFldrDokumente.Name)) >= 0
Then
For
Each
fil
In
fso.GetFolder(subFldrDokumente).Files
If
fil.Name
Like
s_TEILBEZEICHNUNG
Then
With
ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).
End
(xlUp)
.Offset(1, 0).Value = subFldrKunde.ShortName
.Offset(1, 1).Value = subFldrArtikel.Name
.Offset(1, 2).Value = subFldrDokumente.Name
.Offset(1, 3).Value = fil.Name
.Parent.Hyperlinks.Add Anchor:=.Offset(1, 3), Address:=subFldrDokumente.Path &
""
& fil.Name
End
With
End
If
Next
End
If
Next
End
If
Next
End
If
Next
End
Sub