Hallo zusammen,

ich habe folgendes Problem und hoffe Ihr könnt mir helfen.

Ich habe eine Excel-Tabelle mit den Spalten: Teilenummer / Teilebezeichnung / E-Mail-Adresse / Name

Ich habe bereits ein Code geschrieben der eine E-Mail automatisch an jede E-Mail-Adresse schickt mit dem Namen, Teilenummer und Teilebezeichnung in der gleichen Zeile.

Sub EMail_versenden()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim body As String
    Dim SigString As String
    Dim Signatur As String
    
       
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
        
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Flo.htm"
                
    If Dir(SigString) <> "" Then
            Signatur = GetSig(SigString)
        Else
            Signatur = ""
    End If

    On Error GoTo cleanup
    
    For Each cell In Columns("M").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
            LCase(Cells(cell.Row, "I").Value) > 3 And _
            LCase(Cells(cell.Row, "H").Value) > 50 And _
            LCase(Cells(cell.Row, "O").Value) <> "email wurde versendet" Then
      
            On Error Resume Next
    
            body = "<font face=Arial>" & "Hallo " & Cells(cell.Row, "N").Value & ",<br><br>" & _
                    "wegen folgendem Teil wurde zu oft ein GW-Antrag gestellt: <br><br>" & _
                    "<font color=blue>" & Cells(cell.Row, "C").Value & "</font>  " & _
                    "<font color=green>" & Cells(cell.Row, "D").Value & "</font><br><br>" & _
                    "Mit der Bitte um schnelle Antwort.<br><br>" & _
                    "Mit freundlichen Grüßen<br>" & _
                         
            Set OutMail = OutApp.CreateItem(0)
            
            With OutMail
                    .To = cell.Value
                    .Subject = "EWIR"
                    .HTMLBody = body & "<br><br>" & Signatur
                                       '.Send
                    .Display
                 
            End With
            
            Cells(cell.Row, "O").Value = "email wurde versendet"
            Cells(cell.Row, "O").Interior.ColorIndex = 4
            Cells(cell.Row, "O").HorizontalAlignment = xlCenter
                    
                                
            On Error GoTo 0
            
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "E-Mails wurden versendet!"
End Sub


Function GetSig(ByVal sFile As String) As String
    Dim x As Object
    Dim i As Object
    Set x = CreateObject("Scripting.FileSystemObject")
    Set i = x.GetFile(sFile).OpenAsTextStream(1, -2)
    GetSig = i.ReadAll
    i.Close
End Function

Jetzt hab ich nur ein Problem und zwar kommen öffters die gleichen E-Mail-Adressen vor aber immer mit verschiedenen Teilenr./Teilebezeichnungen.

Es wird also bei jedem neuen Teil eine E-Mail verschickt, so dass es vorkommt, dass eine E-Mail-Adresse 10 E-Mails bekommt.

 Ich will aber nur eine E-Mail an jede E-Mail-Adresse verschicken in der dann alle Teilebezeinungen/-nummern enthalten sind.

Ich es ist viel verlangt aber ich hoffe wirklich einer kann mir weiter helfen.

Vielen Dank schon mal :-D