Private
Const
Ordnername
As
String
= "C:\Jahre\"
Public
Sub
Test()
Call
Import(
"02.03.2020"
)
End
Sub
Public
Sub
Import(Dateiname_datum
As
String
)
Dim
D
As
Date
, Jahr
As
String
, Monat
As
String
, strDatei
As
String
Dim
z
As
Integer
, s
As
Integer
ThisWorkbook.Worksheets(
"Ausgabe"
).Range(
"A2:C7"
).ClearContents
On
Error
GoTo
Ende
D = DateValue(Dateiname_datum)
Jahr = Year(D)
Monat = Format(D,
"MMMM"
)
strDatei = Dir(Ordnername & Jahr &
"\" & Monat & "
\")
Do
Until
strDatei =
""
If
Left(strDatei, InStrRev(strDatei,
"."
) - 1) = Dateiname_datum
Then
With
ThisWorkbook.Worksheets(
"Ausgabe"
)
For
z = 2
To
7
For
s = 1
To
3
.Cells(z, s) =
"='"
& Ordnername & Jahr &
"\" & Monat & "
\[
" & strDatei & "
]
" & "
Übersicht'!" & Cells(z, s).Address(
False
,
False
)
Next
s
Next
z
End
With
End
If
strDatei = Dir
Loop
Exit
Sub
Ende:
MsgBox
"Fehler aufgetretten!!!"
End
Sub