Datum aus Dateinamen auslesen

Mark · 2021-11-26T09:03:58+00:00

Moin, oftmals habe ich hier im Forum schon gute Hilfe gefunden, jetzt habe ich aber keinen passenden Eintrag finden können. Mein Problem: Ich habe viele Dateien, die in ein bestimmtest Format umbenannt werden müssen und dazu benötige ich das Datum aus dem Dateinamen. Das Datum kann aber in allen möglichen Varianten vorkommen, wie z.B. 20201122 oder 2020-11-22 oder 22.11.2020 usw. Reguläre Ausdrücke kann ich leider nicht benutzen, weil ich nur den Standardfunktionsumfang von Excel nutzen kann (Firmenpolitik) Gibt es eine einfache Möglichkeit das Datum aus dem Dateinamen zu extrahieren? Der Dateiname liegt mir als String vor. Ich steh irgendwie auf der Leitung und komme nicht selber drauf. Vielen Dank für jeden Zaunpfahl ;) Grüße, Mark

Ja, das ist eine Fehlermöglichkeit, die bestehen bleibt.
Da könnte man höchstens bei einer solchen unklaren Konstellation einen Benutzerentscheid abfragen.


Option Explicit
Sub Test_Datum()
Dim Arr(7), Z, Ext As String, i As Integer
Dim TmpT As String, TmpZ As String, JaNein
'Beispiele
Arr(1) = "2021.21.11 XXXXXXX XXXX.xlsx" 'falsche Reihenfolge automatisch berichtigen
Arr(2) = "2021.11.21 XXXXXXX XXXX.xlsx" 'richtige Reihenfolge unklar
Arr(3) = "2021.12.03 XXXXXXX XXXX.xlsx" 'richtige Reihenfolge unklar
Arr(4) = "XXX- XXX- XXX--XXX_20211121_XXXXXXXXXX.xlsx"
Arr(5) = "2021-11-21 XXXXXXX XXXX.xlsx"
Arr(6) = " XXXXXXX2021.11-21 XXXX.xlsx"
Arr(7) = "ABC.xlsx"
Ext = ".xlsx"
For Z = 1 To 7
Arr(Z) = Replace(Arr(Z), Ext, "")
Arr(Z) = Replace(Arr(Z), Ext, "_")
TmpZ = ""
TmpT = ""
For i = 1 To Len(Arr(Z))
If IsNumeric(Mid(Arr(Z), i, 1)) Or Mid(Arr(Z), i, 1) = "." Then
'Ziffer oder Punkt
TmpZ = TmpZ & Mid(Arr(Z), i, 1)
ElseIf i > 1 Then
If IsNumeric(Mid(Arr(Z), i - 1, 1)) _
And IsNumeric(Mid(Arr(Z), i + 1, 1)) _
And Mid(Arr(Z), i, 1) = "-" Then
'- wenn davor und danach eine Ziffer
TmpZ = TmpZ & Mid(Arr(Z), i, 1)
Else
TmpT = TmpT & Mid(Arr(Z), i, 1)
End If
Else
'Text
TmpT = TmpT & Mid(Arr(Z), i, 1)
End If
Next
If (Len(TmpZ) = 8 And IsNumeric(TmpZ)) Then
'Zahl 8 Stellig
TmpZ = Format(TmpZ, "0000-00-00")
ElseIf IsDate(TmpZ) Then
JaNein = MsgBox(TmpZ & vbLf & vbLf & "Tag und Monat richtig (Ja) oder vertauschen (Nein)", vbYesNo, Arr(Z))
If JaNein = vbNo Then
TmpZ = MonatTag(TmpZ)
End If
ElseIf Len(TmpZ) = 10 Then
'Wenn mit Punkt aber Monat mit Tag vertauscht
TmpZ = MonatTag(TmpZ)
End If
If IsDate(TmpZ) Then
MsgBox Format(TmpZ, "YYYYMMDD") & "_" & TmpT, , Arr(Z)
Else
MsgBox Arr(Z) & " ist kein Datum"
End If
Next
End Sub
Function MonatTag(TT)
Dim TmpZ
MonatTag = Split(TT, ".")(0) & Split(TT, ".")(2) & Split(TT, ".")(1)
MonatTag = Format(MonatTag, "0000-00-00")
End Function

LG UweD

Moin,
An dieser Stelle einmal ganz herzlichen Dank für all eure Mühen und guten Ideen! Mit eurer Hilfe habe ich für mein Problem folgenden Code erfolgreich getestet:


Sub Test_Datum()
Dim Arr(13), Z, Ext As String, i As Integer, TmpI As Integer
Dim TmpT As String, TmpZ As String, TmpL As String
Dim TmpD As Boolean
Dim TmpTest As String
'Beispiele
Arr(1) = "2021.21.11 XXXXXXX XXXX.xlsx" 'falsche Reihenfolge
Arr(2) = "2021.11.21 XXXXXXX XXXX.xlsx" 'richtige Reihenfolge
Arr(3) = "XXX- XXX- XXX--XXX_20211121_XXXXXXXXXX.xlsx"
Arr(4) = "2021-11-21 XXXXXXX XXXX.xlsx"
Arr(5) = " XXXXXXX2021.11-21 XXXX.xlsx"
Arr(6) = "ABC.xlsx"
Arr(7) = "2021.21.11 XXX795 XX5.xlsx"
Arr(8) = "2021.22.11 XXX796 XX2.xlsx"
Arr(9) = "2021.23.11 XXXX97 XX5.xlsx"
Arr(10) = "2021.24.11 XXX798 XX5.xlsx"
Arr(11) = "XXX -XXX - XXX - -XXX_20211121_XXX.xlsx"
Arr(12) = "XXX -XXX - XXX - -XXX_20211122_XX.xlsx"
Arr(13) = "XXX -XXX - XXX - -XXX_20211123_XX.xlsx"
For Z = 1 To 13
TmpZ = ""
TmpT = "0123456789.-/_"
TmpL = ""
TmpI = 0
TmpD = False 'Serie von Ziffern oder Datumstrennern
For i = 1 To Len(Arr(Z))
TmpTest = Mid(Arr(Z), i, 1)
If InStr(1, TmpT, Mid(Arr(Z), i, 1), vbTextCompare) Then 'suche nach Datumskomponente
If (IsNumeric(TmpL) Or IsNumeric(Mid(Arr(Z), i, 1))) And i - TmpI  "" Then Exit For 'Datum wurde gefunden,
'resetten (2 Sonderzeichen in Folge, Lücke, nix passendes gefunden)
TmpI = i
TmpL = ""
End If
Next i
Debug.Print "Datum: " & TmpZ
Next Z
End Sub
Function checkDate(myTest As String) As String
Dim JaNein
myTest = Replace(myTest, ".", "-") 'Punkt zu Strich
myTest = Replace(myTest, "/", "-") 'Eigentlich in Dateiname nicht erlaubt aber ggf. für andere Funktion zu gebrauchen
myTest = Replace(myTest, "_", "-") 'Unterstrich zu Strich
If Right(myTest, 1) = "-" Then
myTest = Left(myTest, Len(myTest) - 1)
End If
If Len(myTest) = 8 And IsNumeric(myTest) Then '00000000
If Not IsDate(Format(myTest, "0000-00-00")) Then
myTest = MonatTag(Format(myTest, "0000-00-00")) 'tausche Monat und Tag
Else
JaNein = MsgBox(Format(myTest, "0000-00-00") & vbLf & vbLf & "Sind Tag und Monat in der richtigen Reihenfolge (Ja) oder vertauscht (nein)?", vbYesNo, "Datum unklar")
If JaNein = vbNo Then
myTest = MonatTag(Format(myTest, "0000-00-00"))
End If
End If
myTest = Format(myTest, "0000-00-00") 'Zahl zu Datum
ElseIf Len(myTest) = 10 And Not IsDate(myTest) Then '0000-00-00
myTest = MonatTag(myTest) 'tausche Monat und Tag
myTest = Format(myTest, "0000-00-00") 'Zahl zu Datum
End If
If IsDate(myTest) Then
checkDate = myTest
End If
End Function
Function MonatTag(myTest As String) As String
myTest = Replace(myTest, ".", "-")
myTest = Replace(myTest, "/", "-")
myTest = Replace(myTest, "_", "-")
MonatTag = Split(myTest, "-")(0) & Split(myTest, "-")(2) & Split(myTest, "-")(1)
End Function

Für die produktive Anwendung muss das Array noch raus und die Variablen würde ich noch dem Namenschema anpassen, aber das geht ja recht fix.
Noch einmal Danke für alle guten Ideen!

Forumthread: Datum aus Dateinamen auslesen

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Datum aus Dateinamen extrahieren in Excel

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)