Outlook Attachment abspeichern
13.05.2009 10:04:32
jogi
ich möchte in Outlook ein Makro schreiben, dass mir von der E-Mail die Attachments in ein bestimmtes Verzeichnis speichert, jedoch soll an den gespeicherten Dateinamen das Datum der E-Mail drangehängt werden.
Bsp:
Die E-Mail vom 12.05.2009 enthält die Attachments: paul.txt; peter.txt
Gespeichert sollen diese Werden im Pfad: c:\Attachment\
Dateinamen: paul_20090512.txt; peter_20090512.txt
Ich habe auch schon hier eine Routine, jedoch weiß ich nicht wie ich das Empfangsdatum ermittle:
Sub SaveSHS()
'Festlegen der Parameter
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myteils, myteil, myAnhänge, myAnhang As Object
myOrt = ("c:\Attachment\")
On Error Resume Next
'arbeitet die einzelnen Nachrichten ab
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'für alle Teile...
For Each myteil In myOlSel
'Anhänge festlegen
Set myAnhänge = myteil.Attachments
'wenn welche da sind, dann
If myAnhänge.Count > 0 Then
'fügt einen Hinweis in die Email ein
myteil.Body = myteil.Body & vbCrLf & "Entfernte Anhänge:" & vbCrLf
'und für alle Anhänge...
For i = 1 To myAnhänge.Count
'nun werden Sie am Speicherort abgelegt
myAnhänge(i).SaveAsFile myOrt & myAnhänge(i).DisplayName
'hier wird Name und der Ort in der Nachricht eingetragen
myteil.Body = myteil.Body & "Datei: " & myOrt & myAnhänge(i).DisplayName & vbCrLf
Next i
'für alle Anhänge...
While myAnhänge.Count > 0
'entferne es (wird für Outlook 2002/2003 benötigt)
myAnhänge.Remove 1
'entferne es (wird für Outlook 2000 benötigt)
'myAnhänge(1).Delete
Wend
'abspeichern ohne Anhang
myteil.Save
End If
Next
'free variables
Set myteils = Nothing
Set myteil = Nothing
Set myAnhänge = Nothing
Set myAnhang = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
Resume
End Sub
Vielen Dank schon einmal für die nette Hilfe.
Gruss Jogi