Hallo Leute,

ich habe ein Problem mit einem Makro für Outlook. Ich möchte gerne mittels Makro alle Anhänge von allen markierten Mails in eine neue Email einfügen. Also neue Email öffnen, 3-10 Mails markieren und das Makro starten -> alle Anhänge aus den markierten Mails sollen nun in die neue Mail eingefügt werden.

Ich habe leider so gut wie keine Ahnung von VBA oder anderen Programmiersprachen, interessiere mich aber dafür und dachte ich bekomme das schon hin. Nach viel rumbasteln und recherchieren hab ich nun folgendes: 

Option Explicit
 
Public Sub InsertAttachmentsTest()
 
    '=====================================================================
    ' 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
    Dim objSelection As Outlook.Selection
    Dim i As Integer
    
 
    '---------------------------------------------------------------------
    ' Fehlerbehandlung wegen Set-Anweisungen ausschalten
    '---------------------------------------------------------------------
    On Error Resume Next
      
    '---------------------------------------------------------------------
    ' Menge an markierten Mails referenzieren
    '---------------------------------------------------------------------
    Set objSelection = Application.ActiveExplorer.Selection
    
 
    '---------------------------------------------------------------------
    ' Markierte E-Mail referenzieren (= Originalmail)
    '---------------------------------------------------------------------
    Set objMail = Outlook.ActiveExplorer.Selection(i)
    i = 0
    
    '---------------------------------------------------------------------
    ' Keine E-Mail markiert?
    '---------------------------------------------------------------------
    If objSelection.Count = 0 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

        
If objSelection.Count > i Then i = i + 1

    
Speichern:
 
    '---------------------------------------------------------------------
    ' 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)
 
If objSelection.Count > i Then i = i + 1: GoTo Speichern:

If objSelection.Count = i Then GoTo ExitProc:
       
  
    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

Wenn ich manuell i = 1 setze, klappt es mit einer markierten Mail.  Bei i = 2 wird der Anhang der 2. markierten Mail in die neue Mail kopiert. Deswegen dachte ich ich erhöhe i jeweils um 1 für jede markierte Mail und das Script wird für jedes i ausgeführt. Leider klappt das nicht und kein Anhang wird in die neue Mail kopiert.

Kann mir jemand helfen?