Navigation

Serienmails mit Outlook

  • : Function split() is deprecated in /var/www/vhosts/k97518.web259.dogado.net/WWWROOT/92652/htdocs/modules/filter/filter.module on line 1200.
  • : Function split() is deprecated in /var/www/vhosts/k97518.web259.dogado.net/WWWROOT/92652/htdocs/modules/filter/filter.module on line 1200.

Wie gestaltet man Serienmails?

Dim objOutlook          As Outlook.Application
Dim objNameSpace        As Outlook.NameSpace
Dim objDefaultEMail     As Outlook.MAPIFolder
Dim objEMail            As Outlook.MailItem
Dim rs                  As DAO.Recordset
Dim strTo               As String

'//Outlook öffnen und eine neue EMail erstellen
Set objOutlook = New Outlook.Application
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objDefaultEMail = objNameSpace.GetDefaultFolder(olFolderOutbox)
Set objEMail = objDefaultEMail.Items.Add(olMailItem)


Set rs = CurrentDb.OpenRecordset("tblEMail")
Select Case MsgBox("Mit 'Ja' werden viele EMails einzeln versendet, " & _
                        "mit 'Nein' wird eine EMail an viele versendet, " & _
                        "mit 'Abbrechen' passiert nichts.", _
                        vbYesNoCancel Or vbExclamation Or vbDefaultButton3, _
                        "Auswahl")

    Case vbYes
        '**************************************************
        '|VARIANTE 1, Hier wird ein Recordset durchlaufen |
        '|Und jede EMail wird einzeln versendet           |
        '**************************************************
            While Not rs.EOF
                Set objEMail = objDefaultEMail.Items.Add(olMailItem)
                With objEMail
                    .To = rs!EMail
                    .Subject = Me!txtBetreff
                    If Len(Nz(Me!txtText, "")) <> 0 Then .Body = Me!txtText
                    rs.MoveNext
                    .Send
                End With
                Set objEMail = Nothing
                'Die EMails werden hier nur gespeichert, da ein Anzeigen leider die Routine stoppt
            Wend

    Case vbNo
        '**************************************************
        '|VARIANTE 2, Hier wird eine Variable mit dem     |
        '|Inhalt des Recordsets gefüllt und dann übergeben|
        '**************************************************
        Set objEMail = objDefaultEMail.Items.Add(olMailItem)
        strTo = vbNullString
        While Not rs.EOF
            strTo = strTo & ";" & rs!EMail
            rs.MoveNext
        Wend
        objEMail.To = strTo
        objEMail.Subject = Me!txtBetreff
        If Len(Nz(Me!txtText, "")) <> 0 Then objEMail.Body = Me!txtText
        objEMail.Display

    Case vbCancel

End Select

'//Aufraeumen nicht vergessen!
Aufraeumen:
    rs.Close
    Set rs = Nothing
    Set objOutlook = Nothing
    Set objNameSpace = Nothing
    Set objDefaultEMail = Nothing
    Set objEMail = Nothing