AW: VBA & Outlook & Anhänge speichern
08.11.2016 15:20:18
baschti007
Hey Das könntest du so machen
Gruß Basti
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 = "C:\Bastian\Add\"
'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, "dd.mm.yyyy") & "_" & Anlagen.Item(i).Filename
'Anlage speichern
Anlagen.Item(i).SaveAsFile Datei
End If
Next i
End If
End Sub
Sub Los()
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
End Sub