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
|