Mails und Anlagen - Makro
05.05.2017 09:29:14
Tarje_089
ich habe ein kleines Problem in Outlook und hoffe ihr könnt mir weiterhelfen.
Problemstellung:
Bei mir gehen eine große Anzahl von Mails ein, welche i.d.R. auch viele Anhänge enthalten.
Ich möchte nun jede eingehende Mail automatisch auf dem Laufwerk in einem definierten Ordner ablegen und vor den Betrett das Eingangsdatum im Form YYYY-MM-TT hh-mm setzen.
Innerhalb dieses Ordners soll für jeden Sender ein Unterordner erstellt warden und in diesen die Mails und Anlagen abgelegt warden.
Bei den Anlagen soll auch das Eingangsdatum der Mail und die Uhrzeit vorangestellt werden.
Nun habe ich bereits ein Makro, welches zumindest die Anhänge automatisiert auf dem Laufwerk ablegt und das Empfangsdatum voranstellt (Uhrzeit müsste ich noch ergänzen).
Allerdings wird die Mail nicht mit abgelegt.
Nachfolgend der aktuelle Code:
Sub Anlagen_Speichern(olMail As MailItem)
'Objekte/Variablen deklarieren
Dim Ziel As String
Dim Anlagen As Attachments
Dim i As Integer
'Speicherordner angeben (bitte mit Backslash abschließen!)
Ziel = "L:\AGCS\GER\Claims\LIAB\Muenchen\HIRN\Paperless\"
'Abbruch, wenn Ordner nicht vorhanden
If Dir(Ziel, vbDirectory) = "" Then Exit Sub
'Mailanhänge ermitteln
Set Anlagen = olMail.Attachments
If Anlagen.Count 0 Then
Ziel = Ziel & olMail.Sender & "\"
If Dir(Ziel, vbDirectory) "" Then
Else
MkDir (Ziel)
End If
'alle Anhänge der Mail durchlaufen und speichern
For i = 1 To Anlagen.Count
'Dateiname zusammensetzen, Datum ist Empfangsdatum der Mail
If Anlagen.Item(i).Type 6 Then
Datei = Ziel & Format(olMail.ReceivedTime, "yyyy-mm-dd") & " " & Anlagen.Item(i).FileName
'Anlage speichern
Anlagen.Item(i).SaveAsFile Datei
End If
Next i
End If
End Sub
Sub Mail_Neu()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
Dim oFolder As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
For Each oMail In Items
Call Anlagen_Speichern(oMail)
Next
Sofern mir jemand weiterhelfen könnte, ware ich sehr dankbar.
Beste Grüße
Tarje