Mails via VBA Makro aus Excel mit Anhang versenden

Sub Mails_versenden()
'  
'  
' Tastenkombination: Strg+b  
'  
If MsgBox("Sollen die Anschreiben nun versendet werden?", vbYesNo) <> vbYes Then Exit Sub  
 
         
 Dim ws As Worksheet, rngSource As Range, dic As Object, c As Range, firstAddress As String, cell As Range
    'Dictionary Objekt erzeugen indem wir die bereits bearbeiteten Zeilen hinterlegen  
    Dim MyMessage As Object, MyOutApp As Object
    Dim SavePath As String
    Dim AWS As String
    Dim Rng2Copy As Range, Rng2Paste As Range
    Dim aWerte()
    Dim i As Long
    Dim x As Integer
    
    Application.ScreenUpdating = False
    
    
    
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    
    'Spalte U=versenden  
    
    If Cells(i, 21) = "versenden" Then  
        
    
       'Bereich Aus Mastertabellenblatt in neues Tabellenblatt  

    Rng2Copy = Sheets("Master").Range(Cells(i, 1), Cells(i, 13))  
    Set Rng2Paste = Sheets("Überfüllte_versendet").Range(Cells(i, 1), Cells(i, 13))  
        aWerte() = Rng2Copy
        Rng2Paste = aWerte()
    Set Rng2Copy = Sheets("Master").Cells(i, 18)  
    Set Rng2Paste = Sheets("Überfüllte_versendet").Cells(i, 18)  
        aWerte() = Rng2Copy
        Rng2Paste = aWerte()
     


    
    End If
   Next i
     
    Application.ScreenUpdating = True
     
   

    SavePath = "H:\" '"E:\Eigene Dateien"  
    'Kopiert Sheet "Überfüllte_versendet" in eine neue Mappe  
    'welche nur diese Tabelle enthält  
    Sheets("Überfüllte_versendet").Copy  
    'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel  
    ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"  
    'Mappenname wird an Variable übergeben  
    'und anschliessend gleich geschlossen  
    With ActiveWorkbook
        AWS = .FullName
        .Close
    End With
    
              
    Set dic = CreateObject("Scripting.Dictionary")  
    'Outlook-Objekt erzeugen  
    Set objOL = CreateObject("Outlook.Application")  
    'Tabellenblatt referenzieren  
    Set ws = Worksheets("Master")  
    
    'belegter Range der Zeilen ermnitteln  
    Set rngSource = ws.Range("A1", ws.Cells(Rows.Count, 1).End(xlUp))  
    
    'Für jede Zeile im Range  
    For Each cell In rngSource
        ' wenn die Zeile noch nicht bearbeitet wurde und in Spalte U eine "versenden" steht (20 = Spalte U)  
        If Not dic.Exists(cell.Row) And cell.Offset(0, 20).Value = "versenden" Then  
            Dim strMailBody
            'Mail erzeugen  
            Set objMail = objOL.CreateItem(0)
            'Eigenschaften der Mail zuweisen  
            objMail.Subject = "Bitte bereinigen. Danke"  
            objMail.To = cell.Offset(0, 32).Value
            'Mailbody erzeugen aber noch nicht endgültig der Mail zuweisen  
            objMailBody = cell.Offset(0, 33) & vbNewLine & vbNewLine & cell.Offset(0, 34).Value & vbNewLine
                         
            'In Spalte "Mail" nach dem aktuellen Zellwert in Spalte Mail suchen  
            With rngSource.Offset(cell.Row, 32)
                Set c = .Find(cell.Offset(0, 32).Value, LookIn:=xlValues, lookAt:=xlWhole)
                If Not c Is Nothing Then
                    firstAddress = c.Address
                    Do
                         ' Nur wenn in Spalte U "versenden" steht  
                        If ws.Cells(c.Row, 21).Value = "versenden" Then  
                            'bearbeitete Zeile zum Dictionary hinzufügen, so dass sie später nicht nochmal verwendet wird  
                            If Not dic.Exists(c.Row) Then dic.Add c.Row, ""  
                            'dem Mailbody den Inhalt von Spalte Z hinzufügen  
                            strMailBody = strMailBody & c.Offset(0, 2) & vbNewLine
                            'nächste Fundstelle suchen  
                    End If
                           Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> firstAddress
                     

                End If
                
           
            
            End With
            
           
             
            'Mail zum testen nur anzeigen  
            objMail.Display
         
   objMail.Attachments.Add AWS
       
            
        End If
        
    Next

ActiveWorkbook.Save

Kill AWS
'MsgBox "Anschreiben erfolgreich an Outlook übertragen!"  


Sheets("Überfüllte_versendet").Cells.Clear  
  
End Sub