Attribute VB_Name = "Modul1"
Option Explicit
' generiert E-Mails an Verteiler aus einer EXCEL Tabelle
' Outloock 98 als Objektmodul muß als Verweis existieren
' in Tabelle Mailliste stehen in der Spalte A alle EMailadressen
Sub Mail_Verteiler_senden()
    Dim Zeile As Double
    Dim name As String
    Dim inhalt As String
    '
    ' Tabelle öffnen
    '
    Sheets("Mailliste").Select
    Zeile = 2
    While Trim(Cells(Zeile, 1)) <> ""
            inhalt = ""
            inhalt = inhalt & "Textzeile1 beliebiger Text" & vbCrLf
            inhalt = inhalt & "Textzeile2 noch ein Text  " & vbCrLf
            name = Cells(Zeile, 1) 'Mailadresse
            '
            Call SendMessage(False, name, inhalt)
            '
        Zeile = Zeile + 1
    Wend
End Sub
'
' Senden eine Mail Outlook98 / Outlook2000
' Outloock 98 als Objektmodul muß als Verweis existieren
' Text und Betreff sind fest eingestellt im Code
'
' Parameter : DisplayMsg      : Vor Senden Anzeige
'             name            : EMail Adresse
'             AttachementPath : Anlage(Datei)
 Sub SendMessage(DisplayMsg As Boolean, name As String, _
    inhalt As String, Optional AttachmentPath)
   ' Deklaration der Objekte
   Dim objOutlook As Outlook.Application
   Dim objOutlookMsg As Outlook.MailItem
   Dim objOutlookRecip As Outlook.Recipient
   Dim objOutlookAttach As Outlook.Attachment
   '
   ' Setzen der Outlook-Session
   Set objOutlook = CreateObject("Outlook.Application")
   ' Mitteilung schreiben
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
   With objOutlookMsg
       ' Zur Empfängerliste hinzufügen
       Set objOutlookRecip = .Recipients.Add(name)
       objOutlookRecip.Type = olTo
       ' Zur CC-Empfängerliste hinzufügen
       ' Set objOutlookRecip = .Recipients.Add("meier@gmx.de")
       ' objOutlookRecip.Type = olCC
       ' Zur BCC-Empfängerliste hinzufügen (= CC / nicht sichtbar für andere Empfänger)
       ' Set objOutlookRecip = .Recipients.Add("mueller@gmx.de")
       ' objOutlookRecip.Type = olBCC
       ' Subjekt, Hauptteil, und Wichtigkeit der Nachricht
       .Subject = "Betrefftext"    ' hier immer Kostant
       .body = inhalt
       ' .Importance = olImportanceHigh 'Wichtigkeit der Mail
       ' Attachments anhängen
       If Not IsMissing(AttachmentPath) Then
          Set objOutlookAttach = .Attachments.Add(AttachmentPath)
       End If
       ' Resolve each Recipient's name
       For Each objOutlookRecip In .Recipients
         objOutlookRecip.Resolve
       Next
       ' Soll die Nachricht gezeigt werden bevor sie gesendet wird?
       ' Diese Bedingung fragt den von Aufruf übergebenen Wert ab
       ' (True = Mitteilung zeigen und manuell senden, False = direkt senden)
       If DisplayMsg Then
        .Display
       Else
        .Send
      End If
    End With
    Set objOutlook = Nothing
  End Sub