Daum im Dateinamen

Dieses Thema Daum im Dateinamen im Forum "Microsoft Office Suite" wurde erstellt von friedel-crafts, 31. März 2007.

Thema: Daum im Dateinamen Hallo, gibt es eine Möglichkeit das aktuelle Datum beim Speichern in den Dateinamen automatisch einzufügen?

  1. Hallo,
    gibt es eine Möglichkeit das aktuelle Datum beim Speichern in den Dateinamen automatisch einzufügen?
     
  2. Hallo friedel-crafts,

    für welche Application soll das erfolgen ?

    Wie soll denn dein Datum aussehen , Dateiname_yyyymmdd.Endung ?
    Oder auf die Sekunde, Dateiname_yyyymmdd_hhnnss.Endung ?

    Gruß Matjes :)
     
  3. Es soll zB für Word 07 sein.
    Datum sollte ausreichen!
     
  4. Hallo friedel-crafts,

    sichere dein Normal.dotm bzw. Normal.dotm(für 2007) !!!

    Dann gebe nachfolgenden Code in ThisDocument deiner Normal.dot  bzw. Normal.dotm(für 2007) ein.

    Funktion:
    beim Speichern von Word-Dokumenten wird dem Dateinamen das Datum in Form von _yyyymmdd angefügt.
    Ausgenommen sind
      - das erstmalige Speichern
      - Dokumentenvorlagen
      - ist bereits ein Datum der Form enthalten, wird es durch das aktuelle ersetzt.

    Gruß Matjes :)
    Code:
    Option Explicit
    Private WithEvents MyWord As Word.Application
    
    Private Sub Document_New()
      Set MyWord = Application
    End Sub
    
    Private Sub Document_Open()
      Set MyWord = Application
    End Sub
    
    Private Sub MyWord_DocumentBeforeSave(ByVal doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
      
      Dim sFilename As String, sFilenameNeu As String
      Dim pos As Long
      
      If Not SaveAsUI Then
        pos = InStr(1, .dot, doc.Name)
       ->keine Dokumentenvorlage ?
        If pos = 0 Then
         ->Wenn _Save, dann Namen prüfen
          sFilename = doc.Name
          Call Dateinamen_Datum_Anhaengen_Ersetzen(sFilename, sFilenameNeu)
          
         ->mit neuem Namen speichern
          Application.DisplayAlerts = wdAlertsNone
          doc.SaveAs FileName:=doc.Path & Application.PathSeparator & sFilenameNeu
          Application.DisplayAlerts = wdAlertsAll
        End If
      End If
    End Sub
    
    
    '*************************************************************************
    Private Function Dateinamen_Datum_Anhaengen_Ersetzen(sDNameAlt As String, _
                                                         sDNameNeu As String)
      
      Dim sDate As String, sDatum As String, dDate As String
      Dim sEndung As String, sDName As String
      Dim pos As Long, posLast As Long
      
      sDName = sDNameAlt
      
     ->Endung abschneiden
      pos = InStr(1, sDName, .)
      If pos > 0 Then
        Do
          posLast = pos
          pos = InStr(posLast + 1, sDName, .)
          If pos = 0 Then Exit Do
        Loop
        sEndung = Right(sDName, Len(sDName) - (posLast - 1))
        sDName = Left(sDName, posLast - 1)
      Else
        sEndung = 
        sDName = sDName
      End If
      
     ->pruefen, ob DNameAlt bereits ein Datum mit entsprechendem Format enthält
     ->nein: Datum _yyyymmdd anfuegen, ja  : Datum _yyyymmdd ersetzen, wenn ungleich
      sDate = Format(Now(), _yyyymmdd)
      If Len(sDName) > (Len(sDate)) Then
        If Right(sDName, Len(sDate)) <> sDate Then
          If IstEinDatum(Right(sDName, Len(sDate))) Then
           ->ja  : Datum _yyyymmdd ersetzen
            sDNameNeu = Left(sDName, Len(sDName) - Len(sDate)) & sDate & sEndung
          Else
           ->nein: Datum _yyyymmdd anfuegen
            sDNameNeu = sDName & sDate & sEndung
          End If
        Else
         ->Datum gleich, bleibt so
          sDNameNeu = sDName & sEndung
        End If
      Else
       ->nein: Datum _yyyymmdd anfuegen
        sDNameNeu = sDName & sDate & sEndung
      End If
      
    End Function
    
    '*************************************************************************
    Private Function IstEinDatum(sDatum As String) As Boolean
      
      Dim sStr As String, lLong As Long
      
     ->Datum muß _yyyymmdd entsprechen
      IstEinDatum = False
        
     ->_ prüfen
      If Mid(sDatum, 1, 1) <> _ Then GoTo AUFRAEUMEN
      On Error Resume Next
     ->Jahr prüfen
      sStr = Mid(sDatum, 2, 4)
      lLong = sStr
      If Err.Number <> 0 Then GoTo AUFRAEUMEN
      If Not (2007 <= lLong And lLong <= 2039) Then GoTo AUFRAEUMEN
     ->Monat prüefen
      sStr = Mid(sDatum, 6, 2)
      lLong = sStr
      If Err.Number <> 0 Then GoTo AUFRAEUMEN
      If Not (1 <= lLong And lLong <= 12) Then GoTo AUFRAEUMEN
     ->Tag prüefen
      sStr = Mid(sDatum, 8, 2)
      lLong = sStr
      If Err.Number <> 0 Then GoTo AUFRAEUMEN
      If Not (1 <= lLong And lLong <= 31) Then GoTo AUFRAEUMEN
      
      IstEinDatum = True
    AUFRAEUMEN:
      Err.Clear: On Error GoTo 0
    End Function
     
  5. Danke dir, funktioniert!!
     
Die Seite wird geladen...

Daum im Dateinamen - Ähnliche Themen

Forum Datum
Daumentaste zurück Web-Browser 31. März 2009
[Tipp] Flipbook Printer - Daumenkinos erstellen Windows XP Forum 14. Jan. 2006
Daumen hoch in der Taskleiste Windows XP Forum 30. Okt. 2005
Dateinamen einfügen mit VBA Microsoft Office Suite 19. Aug. 2014
Suche Tool, um zu lange Dateinamen zu erkennen und dann zu kürzen Software: Empfehlungen, Gesuche & Problemlösungen 4. Juni 2013