Hallo Alexandra2011,

anbei die Lösung mit einer Accesstabelle der Ansprechpartner

'
' Lesen einer Excel-Datei und Ausgabe in einer E-Mail
' Autor: DeKor
' 28.07.2011
'
' ===============================
 
   Option Explicit
   ' Variablen deklarieren
   Dim ExcelObjekt, Zaehler, n
   Dim strID, strFirstName, strLastname, strAP, strEMail
   Dim Anzahl, Liste, Message
   Dim ol, Mail
 
   ' Excel-Objekt erzeugen
   Set ExcelObjekt = CreateObject("Excel.Application")
   ' Excel unsichtbar machen
   ExcelObjekt.Visible = False
   ExcelObjekt.Workbooks.Open "C:\Temp\AP Liste.xls"
 
   ' Eine Auswahl erzeugen
   Anzahl = ExcelObjekt.Worksheets(1).UsedRange.Rows.Count
   Dim Speicher(32000)
   For n = 2 To Anzahl
      Speicher(n) = True
   Next
   ' Durchlaufe alle Zeilen
   For Zaehler = 2 To Anzahl
      ' Ausllesen der Werte
      With ExcelObjekt
         If Speicher(Zaehler) Then
            Liste = ""
            strID        = .Cells(Zaehler,1).Value
            strFirstName = .Cells(Zaehler,2).Value
            strLastName  = .Cells(Zaehler,3).Value
            strAP        = .Cells(Zaehler,4).Value

'------------------------------------------------------------------
' Ansprechpartner E-Mail-Adresse aus Access-Tabelle holen
'------------------------------------------------------------------
            Dim Dbs, db, rs
            Dim strSQL
            Set Dbs = CreateObject("DAO.DBEngine.36")
            Set db = Dbs.OpenDatabase("C:\temp\Ansprechpartner.mdb")
            strSQL = "SELECT * FROM Ansprechpartner WHERE Name LIKE '"& strAP &"'"
            Set rs = db.OpenRecordset(strSQL)
            If rs.RecordCount > 0 Then        ' Daten sind vorhanden
               strEMail = rs.fields(2)
            Else
               strEMail = ""
            End If
            rs.Close
            Set rs = Nothing
            Set db = Nothing

'------------------------------------------------------------------

            Message = vbCrLf & _
                      "Sehr geehrte(r) " & strAP & "," & vbCrLf & _
                      vbCrLf & _
                      "Sie betreuen folgende Personen: " & vbCrLf & _
                      vbCrLf
            For n = 2 To Anzahl
               If Speicher(n) Then
                  If strID <> .Cells(n,1).Value Then
                     If strAP = .Cells(n,4).Value Then
                        Liste = Liste & .Cells(n,1).Value & " : " &  .Cells(n,2).Value & " " &  .Cells(n,3).Value & vbCrLf
                        Speicher(n) = False                        
                     End If
                  Else
                     'Liste = "Folgende Personen betreut: " & strAP & vbCrLf & vbCrLf
                     Liste = Liste & strID & " : " &  strFirstName & " " &  strLastName  & vbCrLf
                     Speicher(n) = False
                  End If
               End If
            Next
            Message = Message & Liste & vbCrlF & _
                      vbCrLf & _
                      "Mit freundlichen Grüßen" & vbCrLf & _
                      vbCrLf & _
                      "Alexandra 2011"
            ' Ausgabe
            ' wscript.Echo Message
            '
            ' E-Mail senden 
            Set ol = CreateObject("Outlook.Application")
            Set Mail = ol.CreateItem(0)
            Mail.Subject = "Liste der Betreuenden vom: " & Date
            Mail.To = strEMail
            Mail.cc = ""
            Mail.bcc = ""
            Mail.body = Message
            ' Mail zeigen
            Mail.Display
            ' Mail automatisch senden
            'Mail.Send           
         End If
      End With
   Next
   ' ExcelObjekt.Visible = True
   ' Excel wieder beenden
   ExcelObjekt.Quit
' ===============================

Gruß Detlev