Datum aus Dateinamen an beliebiger Position ausles

Hallo zusammen,
Ich habe mehrere Dateien welche ich regelmäßige bearbeiten und mit aktuellem Datum abspeichern muss. Hierfür habe ich mir ein Makro geschrieben, welches die Datei automatisch abspeichert.
Das funktioniert soweit ganz gut, da die meisten Dateien das Datum entweder am Anfang haben bzw. am Ende. Dabei kann die Form des Datums von yyyymmdd zu yymmdd variieren.
Mein Problem ist nun, das ich aktuell immer über eine Userform abfrage welches Format vorliegt und an welcher Position das Datum ist. Wenn das Datum mitten im Dateinamen steckt funktioniert das so nicht mehr.
Gibt es eine Möglichkeit automatisch die Form und die Position des Datums zu erkennen und auszutauschen?
Mein aktueller Code im Modul sieht so aus (Dposition und Datum sind globale Variablen welche _
ich über die Userform definiere):


Public Sub Save()
Application.ScreenUpdating = False
Dim sEndung As String
Dim ilaenge As Integer
Dim iZeichenPkt As Integer
ilaenge = Len(ActiveWorkbook.Name)
iZeichenPkt = InStrRev(ActiveWorkbook.Name, ".")
sEndung = Right(ActiveWorkbook.Name, iWortlaenge - iStellePunkt + 1)
AbfrageD.Show
Dim neu As String
If Dposition = "Ende" Then
neu = Replace(ActiveWorkbook.Name, sEndung, "")
neu = Left(neu, Len(neu) - Len(Datum))
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & neu & Datum & sEndung
Else
neu = ActiveWorkbook.Name
neu = Right(neu, Len(neu) - Len(Datum))
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & Datum & neu
Application.ScreenUpdating = True
End If
End Sub

PS: Über Vorschläge, wie der Code besser zu gestalten wäre bin ich immer Dankbar. Man will sich ja immer weiterentwickeln.
Vielen Dank im Voraus!

Hi
probiers mal so:

Sub test()
Dim NameAlt As String
Dim NameNeu As String
Dim txt As String
Dim i As Long
Dim NeuesDatum As Date
NeuesDatum = Date
NameAlt = ActiveWorkbook.Name
'--- Datum 8 stellen
If NameAlt Like "*########*" Then
For i = 1 To Len(NameAlt) - 7
txt = Mid(NameAlt, i, 8)
If txt Like "########" Then
If IsDate(Format(CLng(txt), "0000-00-00")) Then
NameNeu = NameAlt
Mid(NameNeu, i, 8) = Format(NeuesDatum, "YYYYMMDD")
Exit For
End If
End If
Next
End If
'--- Datum 6-Stellen
If NameNeu = "" And NameAlt Like "*######*" Then
For i = 1 To Len(NameAlt) - 5
txt = Mid(NameAlt, i, 6)
If txt Like "######" Then
If IsDate(Format(CLng(txt), "00-00-00")) Then
NameNeu = NameAlt
Mid(NameNeu, i, 6) = Format(NeuesDatum, "YYMMDD")
Exit For
End If
End If
Next
End If
If NameNeu = "" Then
MsgBox "kein Datum gefunden"
Else
MsgBox NameAlt & vbLf & NameNeu
End If
End Sub

zuerst wird nach dem 8-Stelligem Datum gesucht und wenn dieses nicht vorhanden ist nach dem 6-stelligen.
wenn im Namen auch andere 6-Stellige Zahlenkombinationen vorkommen können, dann kann es natürlich passieren, dass diese dann anstelle des echten Datums ausgetauscht wird.
hier wäre es hilfreich zu wissen, ob das Datum am Anfang oder am Ende steht.
steht das Datum am Ende, müsste man die Schleife rückwärts laufen lassen, damit es als erstes gefunden wird.
ist die Postion unbekannt, hast du ein Problem.
Gruß Daniel

Datum aus Dateinamen an beliebiger Position ausles

Forumthread: Datum aus Dateinamen an beliebiger Position ausles

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial