VBA & Outlook & Anhänge speichern 2
07.06.2018 08:28:29
Christian
ich nehme Bezug auf folgenden Beitrag:
https://www.herber.de/forum/archiv/1520to1524/1523625_VBA_amp_Outlook_amp_Anhaenge_speichern.html
Der Code funktioniert im Outlook Posteingang wunderbar.
Jetzt benötige ich diese Funktion für den Posteingang im Outlook Archive.
Ist das möglich?
Der Code verwendet die Folderkonstante "olFolderInbox" wie kann ich jetzt deklarieren, dass nicht der normale Posteingangsordner, sondern der Posteingangsordner im Arcive durchsucht wird?
Vielen Dank für eure Hilfe!
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