Multi-Mime Mail mit mehreren Attachments versenden

[uscheunemann]

Hallo zusammen,

ich habe ein spezielles Problem beim Versenden von EMails im Mime-Format:
Prinzipiell geht es darum, eine EMail an mehrere ausgewählte Adressaten zu versenden und dabei personenbezogene Elemente (z.B. persönliche Anrede, Verteilhinweis, adressaten-spezifische URLs) einzufügen, also sowas wie ein Serienbrief als EMail.
Dazu:
- speichere ich den EMail-Entwurf im Mime-Format,
- exportiere den text/html-Part als Datei auf die Platte
- erzeuge in einer Schleife für jeden Adressaten eine Mail,
- manipuliere den HTML-Part (Hinzufügen Anrede usw.) anhand der Datei auf der Platte
- speichere die Ziel-EMail zwischen
- versende die EMail und lösche sie sofort
Geht alles ganz gut und hat den Vorteil, dass ich beim Erstellen der Mail beliebige eigene Tags einfügen und beim Versenden durch konkrete Inhalte ersetzen kann.
Wenn aber die EMail mehrere Anhänge enthält, gibt es ein Problem:
sobald ich zwischenspeichere, fliegen alle $File-Felder (außer dem ersten), und alle Body-Felder mit den Attachments (Content-Type: application/octet-stream; ) raus. Die EMail enthält dann tatsächlich nur noch das erste eingefügte Attachtment.

Kann man Lotus Notes das abgewöhnen? Ich versteh auch gar nicht, warum ein schnödes Zwischenspeichern Felder entfernt.

[Gandhi]

Kannst Du bitte etwas Code posten?

[uscheunemann]

'docCurrent ist der Mail-Entwurf, docAdrSrc ist ein Dokument mit einer Liste von EMail-Empfängern
Public Function sendPersonalMailHTML(docCurrent As NotesDocument, docAdrSrc As NotesDocument) As Boolean
Dim itmBody As Variant
.
.
.
sessGlobal.ConvertMIME = False
.
.
Set itmBody = docCurrent.GetFirstItem("Body")   

Call getBodyMime(itmBody, (docCurrent.UseSalutation(0) <> ""), _
   (docCurrent.AppendContributor(0) = "V" And docCurrent.Verteilerhinweis(0) <> ""), _
   (docCurrent.HasQLRef(0) = 1))

   Forall Recipient In vSumAdressList
      Set docMail = New NotesDocument(maildb)
      Call setBasicMailFields (docCurrent, docMail)
      .
      .
      Call prepBodyMime(itmBodyDest, (docCurrent.UseSalutation(0) <> ""),_
            (docCurrent.AppendContributor(0) = "V" And docCurrent.Verteilerhinweis(0) <> ""), _
            (docCurrent.HasQLRef(0) = 1), sID, _
            explode (kernel.getConfigValue("VerteilerPraefix") & docCurrent.Verteilerhinweis(0), "###"))
      Call docMail.Save(True, False) 'hier fliegen dann die $File-und Body-Felder raus, was natürlich nicht gewollt ist
      Call docMail.Send(False)
      Call docMail.Remove(True)
   End Forall   
   .
   .
   sessGlobal.ConvertMIME = True
   Exit Function
ErrorExit:
   Call mLog.addErrorLogComment ("Fehler", 2, vComment, True)
   Exit Function
End Function            

'kopiert alle Felder aus dem Mail-Entwurf (eine spezielle Maske von mir) und das Ziel-Memo
'und löscht dann die Felder raus, die nicht gebraucht werden
'es geht dabei eigentlich nur darum, alle $File- und alle Body-Felder ins Ziel-Dokument zu bekommen
Sub setBasicMailFields (docSource As NotesDocument, docMail As NotesDocument)
   
   On Error Goto ErrorExit
   
   Call docSource.CopyAllItems(docMail, True)
   Call docMail.RemoveItem("AdrSrcID")
   Call docMail.RemoveItem("IsLimitSelection")
   Call docMail.RemoveItem("AddressSource")
   Call docMail.RemoveItem("AdrSrcType")
   Call docMail.RemoveItem("IsSent")
   Call docMail.RemoveItem("DefAuthor")
   Call docMail.RemoveItem("MailServer")
   Call docMail.RemoveItem("MailFile")
   Call docMail.RemoveItem("IsNew")
   Call docMail.RemoveItem("SendOnBehalfOf")
   Call docMail.RemoveItem("HasQLRef")
   Call docMail.RemoveItem("AddSendTo")
   Call docMail.RemoveItem("DispatcheMode")
   Call docMail.RemoveItem("UseSalutation")
   Call docMail.RemoveItem("Verteilerhinweis")
   Call docMail.RemoveItem("AppendContributor")
   Call docMail.RemoveItem("sendToCorres")
   Call docMail.RemoveItem("DefReader")
   
   docMail.Form = "Memo"
   Exit Sub
ErrorExit:
   Call mLog.addErrorLog ("Fehler", 2, False)
   Exit Sub
End Sub

'Schreibt den HTML-MailContent als Datei weg und fügt dabei meine benutzerdefinierten Tags ein
Function getBodyMime(itmBody As Variant, Byval bInsertSalutation As Boolean,_
Byval bInsertContributor As Boolean, Byval bInsertQLRef As Boolean) As Boolean
   Dim mime As NotesMIMEEntity
   Dim child As NotesMIMEEntity
   Dim stream As NotesStream, streamPrep As NotesStream
   Dim sTempFileName$, sPrepFileName$, buffer$
   
   On Error Goto ErrorExit
   
   getBodyMime = False
   
   sTempFileName = Environ("Temp") & "\BodyStream.txt"
   sPrepFileName = Environ("Temp") & "\BodyPrep.txt"
   If (fileExists(sTempFileName)) Then
      Kill sTempFileName
   End If
   If (FileExists(sPrepFileName)) Then
      Kill sPrepFileName
   End If
   Set stream = sessGlobal.CreateStream
   If itmBody.Type = MIME_PART Then
      Set mime = itmBody.GetMIMEEntity
      If (mime.ContentType <> "text") Then
         Set child = mime.GetFirstChildEntity
         While (Not(child Is Nothing) And _
         (child.ContentType <> "text"))
            Set mime = child
            Set child = mime.GetFirstChildEntity
         Wend
      Else
         Set child = mime
      End If
      
      If Not stream.Open(sTempFileName, "ISO-8859-1") Then ', "us-ascii"
         Error 3005, "Erzeugen der temporären Stream-Datei fehlgeschlagen."
      End If
      
      Call child.GetContentAsText(stream)      
      Call stream.Close
      
      If Not stream.Open(sTempFileName, "ISO-8859-1") Then ', "us-ascii"
         Error 3005, "Erzeugen der temporären Stream-Datei fehlgeschlagen."
      End If
      Set streamPrep = sessGlobal.CreateStream
      If (Not streamPrep.Open(sPrepFileName, "ISO-8859-1")) Then ', "us-ascii"
         Error 3005, "Erzeugen der Ziel-Stream-Datei fehlgeschlagen."
      End If
      If (bInsertContributor) Then
         Call streamPrep.WriteText(|<font size="2" face="sans-serif"><CONTRIBUTOR></font><br><br>|, EOL_CRLF)
      End If
      If (bInsertSalutation) Then
         Call streamPrep.WriteText(|<font size="2" face="sans-serif"><SALUTATION></font><br>|, EOL_CRLF)
      End If
      Do
         buffer$ = stream.ReadText(STMREAD_LINE, EOL_CRLF)
         streamPrep.WriteText(buffer$)
      Loop Until stream.IsEOS
      Call stream.Close
      Call streamPrep.Close
      getBodyMime = True
   End If
   
   Exit Function
ErrorExit:
   Call mLog.addErrorLog ("Fehler", 2, False)
   Exit Function
End Function

'mit dieser Funktion manipuliere ich den HTML-Content der Ziel-EMail
'd.h. ich ersetze meine Tags mit konkretem Inhalt
Function prepBodyMime(itmBody As Variant, Byval bInsertSalutation As Boolean,_
Byval bInsertContributor As Boolean, Byval bInsertQLRef As Boolean, sContactID$, _
vContributor) As Boolean
   Dim mime As NotesMIMEEntity
   Dim child As NotesMIMEEntity
   Static viewContact As NotesView
   Dim docContact As NotesDocument
   Dim stream As NotesStream, streamPrep As NotesStream
   Dim sTempFileName$, sPrepFileName$, buffer$, sAnrede$, sContributor$, sContRef$
   Dim bSalutationDone As Boolean, bContribDone As Boolean, bQLRefDone As Boolean
   
   On Error Goto ErrorExit
   
   prepBodyMime = False
   
   bSalutationDone = False
   bContribDone = False
   bQLRefDone = False
   sPrepFileName = Environ("Temp") & "\BodyPrep.txt"
   sTempFileName = Environ("Temp") & "\BodyStream.txt"
   If (fileExists(sTempFileName)) Then
      Kill sTempFileName
   End If
   
   If (viewContact Is Nothing) Then
      Set viewContact = dbCurrent.GetView("ContactByDocID")
   End If
   If (bInsertSalutation And Trim(sContactID) <> "" And Trim(sContactID) <> "-") Then
      Set docContact = viewContact.GetDocumentByKey(sContactID, True)
   End If
   If (docContact Is Nothing) Then
      sAnrede = "Sehr geehrte Damen und Herren,"
   Else
      sAnrede = docContact.AnredeText(0)
   End If
   If (Trim(sContactID) <> "" And Trim(sContactID) <> "-") Then
      sContRef = "&ContactID=" & sContactID
   Else
      sContRef = ""
   End If
   
   Set stream = sessGlobal.CreateStream
   If itmBody.Type = MIME_PART Then
      Set mime = itmBody.GetMIMEEntity
      If (mime.ContentType <> "text") Then
         Set child = mime.GetFirstChildEntity
         While (Not(child Is Nothing) And _
         (child.ContentType <> "text"))
            Set mime = child
            Set child = mime.GetFirstChildEntity
         Wend
      Else
         Set child = mime
      End If
      
      Set streamPrep = sessGlobal.CreateStream
      If (Not streamPrep.Open(sPrepFileName, "ISO-8859-1")) Then ', "us-ascii"
         Error 3005, "Öffnen der Ziel-Stream-Datei fehlgeschlagen."
      End If
      Do
         buffer$ = streamPrep.ReadText(STMREAD_LINE, EOL_CRLF)
         
         If (bInsertContributor And (Not bContribDone) And _
         (Instr(Buffer, "<CONTRIBUTOR>") <> 0)) Then
            sContributor = Implode(vContributor, "<br>")
            buffer = replaceSubString(buffer, "<CONTRIBUTOR>", sContributor)
            stream.WriteText(buffer$)
            bContribDone = True
            Elseif (bInsertSalutation And (Not bSalutationDone) And _
         (Instr(Buffer, "<SALUTATION>") <> 0)) Then
            buffer = replaceSubString(buffer, "<SALUTATION>", sAnrede)
            stream.WriteText(buffer$)
            bSalutationDone = True
            Elseif (bInsertQLRef And (Not bQLRefDone) And _
         (Instr(Buffer, "&lt;CONTACTREF&gt;") <> 0)) Then
            buffer = replaceSubString(buffer, "&lt;CONTACTREF&gt;", sContRef)
            stream.WriteText(buffer$)
            bQLRefDone = True
         Else
            stream.WriteText(buffer$)
         End If
      Loop Until streamPrep.IsEOS
      
      Call streamPrep.Close
      Call child.SetContentFromText (stream, "text/html;charset=iso-8859-1", ENC_NONE)
      Call stream.Close
      
      prepBodyMime = True
   End If
   
   Exit Function
ErrorExit:
   Call mLog.addErrorLog ("Fehler", 2, False)
   Exit Function
End Function