Anlagen einer E-Mail einfügen

Beim Antworten auf E-Mails werden die Anlagen normalerweise nicht mit zurückgeschickt. Möchte man dies aber dennoch tun, so kann man dazu als Hilfe diesen Code verwenden.

Nach dem Sie auf "Antworten" geklickt haben, wird eine neue E-Mail geöffnet. Je nach Einstellung wird dabei die Original-E-Mail geschlossen. In jedem Fall bleibt sie zunächst markiert. Wenn Sie jetzt diesen Code ausführen, werden die Anlagen der Original-E-Mail in die Antwort eingefügt.

Alternativ zu diesem Code können Sie auch den AttachmentsManager einsetzen, der noch viele weitere Funktionen zur Anlagenbehandlung bietet.

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden. Den Code bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor).

Ab Outlook® 2000 - VB-Skript erforderlich

Option Explicit
 
Public Sub InsertAttachments()
 
    '=====================================================================
    ' Fügt in eine geöffnete E-Mail die Anlagen einer markierten E-Mail ein
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-12-18 Version 1.0.0
    '=====================================================================

    Dim objMail As Outlook.MailItem
    Dim objAnswer As Outlook.MailItem
    Dim objAttachment As Outlook.Attachment
    Dim objAttachments As Outlook.ATTACHMENTS
    Dim strMyDocuments As String
    Dim strAttachment As String
 
    '---------------------------------------------------------------------
    ' Fehlerbehandlung wegen Set-Anweisungen ausschalten
    '---------------------------------------------------------------------
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Markierte E-Mail referenzieren (= Originalmail)
    '---------------------------------------------------------------------
    Set objMail = Outlook.ActiveExplorer.Selection(1)
 
    '---------------------------------------------------------------------
    ' Keine E-Mail markiert?
    '---------------------------------------------------------------------
    If objMail Is Nothing Then GoTo ExitProc
 
    '---------------------------------------------------------------------
    ' Geöffnete E-Mail referenzieren (= Antwort)
    '---------------------------------------------------------------------
    Set objAnswer = Outlook.ActiveInspector.CurrentItem
 
    '---------------------------------------------------------------------
    ' Anlagen der Originalmail referenzieren
    '---------------------------------------------------------------------
    Set objAttachments = objMail.Attachments
 
    '---------------------------------------------------------------------
    ' Ordner "Eigenen Dateien" bzw. "Dokumente" ermitteln
    '---------------------------------------------------------------------
    strMyDocuments = GetMyDocuments
 
    '---------------------------------------------------------------------
    ' Alle Anlagen in die aktuell geöffnete "übertragen"
    '---------------------------------------------------------------------
    For Each objAttachment In objAttachments
 
        '-----------------------------------------------------------------
        ' Anlage temporär speichern
        '-----------------------------------------------------------------
        Call objAttachment.SaveAsFile(strMyDocuments & "\" & objAttachment.FileName)
 
        '-----------------------------------------------------------------
        ' Anlage in Antwort hinzufügen
        '-----------------------------------------------------------------
        Call objAnswer.Attachments.Add(strMyDocuments & "\" & objAttachment.FileName)
 
        '-----------------------------------------------------------------
        ' Temporäre Anlage löschen
        '-----------------------------------------------------------------
        Call Kill(strMyDocuments & "\" & objAttachment.FileName)
 
    Next
 
ExitProc:
 
    '---------------------------------------------------------------------
    ' Clean Up
    '---------------------------------------------------------------------
    Set objMail = Nothing
    Set objAnswer = Nothing
    Set objAttachment = Nothing
    Set objAttachments = Nothing
 
End Sub
 
Private Function GetMyDocuments() As String
 
    '=====================================================================
    ' Gibt den Ordner "Eigene Dateien" zurück
    ' 2008-12-18 Version 1.0.0
    '=====================================================================
 
    Dim objWshShell As Object     ' Windows Script Host
 
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Instanz des Windows Script Host starten
    '---------------------------------------------------------------------
    Set objWshShell = CreateObject("WScript.Shell")
 
    '---------------------------------------------------------------------
    ' Ordner "Eigene Dateien" bzw. "Dokumente" zurückgeben
    '---------------------------------------------------------------------
    GetMyDocuments = objWshShell.SpecialFolders("MyDocuments")
 
    '---------------------------------------------------------------------
    ' Clean Up
    '---------------------------------------------------------------------
    Set objWshShell = Nothing
 
End Function