Button Home/Top/Zurück


E-Mail via Lotus Notes versenden


Mit folgendem Modul kann man E-Mails aus Access via Lotus Notes versenden.
Dank Wolfgang Schecht können nun auch mehrere Empfänger verarbeitet werden.
Die E-Mail Adressen der Empfänger können durch Semikoln getrennt angegeben werden.

Eine weitere Neuerung ist, daß über einen Optionalen Parameter angegeben werden kann, ob die E-Mail sofort versendet werden oder als Entwurf gespeichert werden soll.

Sub SendNotesMail(MailTo As String, MailText As String, MailAnhang As String, _
                  MailAbsender As String, MailBetreff As String, _
                  Optional MailSenden=True As Boolean)
'
' Versenden einer E-Mail via Lotus Notes.
'
' IN: MailTo E-Mail Adresse des Empfängers
' MailText Text der Nachricht
' MailAnhang Dateianhang (Dateiname mit Pfad)
' MailAbsender Name des Absenders (wird an den Text angeängt)
' MailBetreff Betreffzeile der E-Mail
' MailSenden True wenn Nachricht versendet werden soll,
' False wenn Nachricht als Entwurf gespeichert werden soll
'
Dim rtitem As Object
Dim EmbeddedObject As Object
Dim SessionNotes As Object, NotesDB As Object, NotesDoc As Object
Dim EmpfListe() As String
Dim EmpfCnt As Integer
Dim Pos1 As Long
    '
    ' wenn die Betreffzeile leer ist, dann wird eine erzeugt
    '
    If Trim$(MailBetreff) = "" Then
        MailBetreff = "Mail vom " & Date & " " & Time
    End If
    '
    ' Eigene Fehlerbehandlung
    '
    On Error Goto Err_Mail_Click
    '
    ' An die laufende Lotus Notes Session anhängen
    '
    Set SessionNotes = CreateObject("Notes.NOTESSESSION")
    '
    ' Notes Datenbank-Objekt erstellen und initialisieren
    '
    Set NotesDB = SessionNotes.GetDatabase("", "")
    NotesDB.OPENMAIL
    If NotesDB.ISOPEN = False Then
        MsgBox "Bitte melden Sie sich zunächst vollständig in Notes an!", vbInformation + vbOKOnly
        Exit Sub
    End If
    '
    ' Empfängerliste erstellen
    '
    EmpfCnt = 0
    Pos1 = InStr(MailTo, ";")
    While Pos1 > 0
        ReDim Preserv EmpfListe(EmpfCnt)
        EmpfListe(EmpfCnt) = Left(MailTo,Pos1 - 1)
        MailTo = Right(MailTo,Len(MailTo) - Pos1)
        Pos1 = InStr(MailTo, ";")
        EmpfCnt = EmpfCnt + 1
    Wend
    ReDim Preserv EmpfListe(EmpfCnt)
    EmpfListe(EmpfCnt) = MailTo
    '
    ' Neues Notes-Dokument anlegen (Mail)
    '
    Set NotesDoc = NotesDB.CreateDocument
    With NotesDoc
        .Form = "Memo"
        .Subject = MailBetreff
        .sendto = EmpfListe
        '.copyto = ' Kopie an
        '.blindcopyto= Blindkopie an
        .body = MailText & vbCrLf & MailAbsender
        '.DefaultMailSaveOption = 0
        '.MailSaveOption = 0
        .DeliveryReport = "B"
        .Importance = "2"
        '.logo = "Scania"
        .SAVEMESSAGEONSEND = True ' bei True wird ein Exemplar in Notes in Gesendet gestellt
        .ReturnReceipt = "1"
        .Sign = "1"
        '.encrypt ="0"
        '.Principal = session.UserName
        '.viewicon ="74"
        '.from = session.UserName
        '.SaveOptions = 0
        '.SecureMail = ""
        '.SenderTag = "F"

'''''''''''''' Dateianhang'''''''''''''''''

        If Trim$(MailAnhang) <> "" Then
            Const embed_ATT = 1454
            Set rtitem = .CreateRichTextItem(MailAnhang)
            Set EmbeddedObject = rtitem.EmbedObject(embed_ATT, "", MailAnhang, MailAnhang)
        End If

''''''''''''''''''''''''''''''''''''''''''

        If MailSend Then
           .Send False
        Else
           .Save
        End If
    End With

    Set SessionNotes = Nothing
    Set NotesDB = Nothing
    Set NotesDoc = Nothing
    Set rtitem = Nothing
    Set EmbeddedObject = Nothing
    
Exit_Mail_Click:
Exit Sub
Err_Mail_Click:
    MsgBox Err.Description
    Resume Exit_Mail_Click
End Sub

Modul Icon Modul als Textfile zum downloaden.
Die Prozedur könnte z.B. in einem Formular in der Ereignisprozedur Beim Klick eines Senden-Buttons aufgerufen werden.
Hier ist allerdings darauf zu achten, daß als Parameter der Prozedur nicht die Steuerelemente des Formulars sondern
lokale Variablen angegeben werden. In meinen Tests kam es, bei Verwendung der Steuerelemente, zu Laufzeitfehlern.

Die Ereignisprozedur könnte dann so aussehen: 

Private Sub PbSenden_Click()

Dim Empf As String
Dim MText As String
Dim Anlage As String
Dim MBetreff As String
Dim MAbsender As String
    '
    ' Als Absender den angemeldeten User verwenden
    '
    MAbsender = Environ("User")
    '
    ' Prüfen, ob Empfänger angegeben sind
    '
    If IsNull(Me.dfEmpfaenger) Then
        MsgBox "Bitte geben Sie einen Empfänger an"
    End If
    Empf = Me.dfEmpfaenger
    '
    ' Wenn keine Nachricht angegeben ist, dann wird
    ' hier ein Standardtext gesetzt.
    '
    If IsNull(Me.dfMailtext) Then
        MText = "Automatische E-Mail"
    Else
        MText = Me.dfMailtext
    End If
    '
    ' Anhang aus dem Formular übernehmen
    '
    If IsNull(Me.dfAnhang) Then
        Anlage = ""
    Else
        Anlage = Me.dfAnhang
    End If
    '
    ' Wenn kein Betreff angegeben ist, dann
    ' wird hier ein Standardtext gesetzt.
    '
    If IsNull(Me.dfBetreff) Then
        MBetreff = "Automatische Mail vom " & Date$
    Else
        MBetreff = Me.dfBetreff
    End If
    '
    ' Mail abschicken
    '
    SendNotesMail Empf, MText, Anlage, MAbsender, MBetreff
 
    '
    ' Mail als Entwurf speichern
    '
    SendNotesMail Empf, MText, Anlage, MAbsender, MBetreff, False

End Sub

Button Home/Top/Zurück