Hallo zusammen,

ich habe ein Marco für Outlook geschrieben was es ermöglicht Anhänge aus einer Vielzahl markierter Mails auszulesen zu datieren und zu speichern.

Leider habe ich noch ein Problem mit der Stabilität des Macros.
Das Macro läuft nicht durch wenn sich Termineinladungen (Bekomme da irgendwie keine vernünftige IF Bedingung hin) in den Markierten Mails befinden oder wenn ich ein Dateiname am selben Tag doppelt vergeben wurde.

Für Feedback und Lösungsansätze wäre ich euch dankbar!  Viel Spaß beim ausprobieren

Sub Anlage_verschieben()

Dim strPath As String
Dim Mail_Date As String
Dim Mail_Jahr As String
Dim Mail_Monat As String
Dim Mail_Tag As String
Dim Anhang_Name As String


Dim objMail As Outlook.MailItem
Dim intAnlagen As Integer, i As Integer


'On Error Resume Next

'Pfad zu meinem Ordner
strPath = "C:\Neuer Ordner"


'Schleife
For Each objMail In Outlook.ActiveExplorer.Selection
With objMail

'Mails auf vorh. Anlagen prüfen
intAnlagen = .Attachments.Count

'If .ItemProperties = MailItem Then


If intAnlagen > 0 Then

    For i = 1 To intAnlagen
    
    'Datum bestimmen
     Mail_Date = objMail.CreationTime
     Mail_Date = Left(Mail_Date, 10)
     Mail_Jahr = Mid(Mail_Date, 7, 4)
     Mail_Monat = Mid(Mail_Date, 4, 2)
     Mail_Tag = Mid(Mail_Date, 1, 2)
     
     Mail_Date = Mail_Jahr & Mail_Monat & Mail_Tag & "_"
          
     'Neuen Namen zuweisen
     
     Anhang_Name = Mail_Date & .Attachments.Item(i).FileName
     
   
    
    'Anlagen im vordefinierten Verzeichnis sichern
    .Attachments.Item(i).SaveAsFile strPath & "\" & Anhang_Name
    
    Next i

    End If
    
    
    



End With


Next objMail



End Sub