Hei wieder,
Private Const Ordnername As String = "C:\Jahre\" ' <<< \ am ende nicht vergessen
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
Einfach diesen code in ein Modul, die Variable [Ordnername] oben mit deinem Ordnerpfad versehen in dem bei dir alle Jahresordner sind.
Und die Testsub mit einem Datum deiner wahl testen.
Probier es aus.
|