AW: Lösung der Problemstellung
27.11.2021 16:41:46
Mark
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!