Domino 9 und frühere Versionen > ND7: Entwicklung
Serienmail(Serienbrief) mit personalisierte-Anhang
ascabg:
@eknore (Ulrich)
Schreibfehler beim Erstellen der eigenen VBA-Routine (also kein Notes),
da ich diesen Code einfach mal nur auf die schnelle runtergeschrieben habe.
Hatte in einem vorherigen Post auch angedeutet.
--- Zitat ---Diesen Code, erhebt keinen Anspruch auf Vollstaendigkeit.
--- Ende Zitat ---
Andreas
Boulbadaoui:
Ich glaube es liegt daran, daß kein Attachment erzeugt wird!
hier meine Änderung
___________________________
ist die Schreibweise : StrFile = sh.Range("E" & CStr(intRow)) in excel auf die Spalte E : U:\anhang\name.pdf richtig?
Sub hauptteil()
Dim sh As Worksheet
Dim strName As String 'Empfänger-Name
Dim strAdress As String 'E-Mail Addresse des Empfänger
Dim StrFile As String 'Personalisierten Anhang
Dim StrThema As String 'E-Mail Thema
Dim StrTxt As String 'E-Mail Anhang
Dim intRow As Integer
Set sh = ThisWorkbook.ActiveSheet
If sh Is Nothing Then End
For intRow = 1 To 3 'Schleife über alle Rows
strName = sh.Range("C" & CStr(intRow)) & " " & sh.Range("A" & CStr(intRow))
strAdress = sh.Range("D" & CStr(intRow))
StrFile = sh.Range("E" & CStr(intRow))
StrThema = sh.Range("F" & CStr(intRow))
StrTxt = sh.Range("G" & CStr(intRow))
Call SendMailWithFile(strAdress, strName, StrFile, StrTxt, StrThema)
If Trim(strName) = "" Then Exit For
Next
End Sub
Sub SendMailWithFile(ByVal sAdress As String, ByVal sUser As String, sFile As String, sTxt As String, sThema As String)
'Sub SendMailWithFile(ByVal sAdress As String, ByVal sUser As String, sFile As String)
Dim n_ses As New NotesSession
Dim n_dbNames As NotesDatabase
Dim n_dbMail As NotesDatabase
Dim n_docMail As NotesDocument
Dim varMailFile As Variant
' Notes-Session
If n_ses Is Nothing Then Exit Sub
'if 1 und exit
n_ses.Initialize
' NAB oeffnen, um den Mailserver und das Mailfile des aktuellen
' Benutzers zu ermitteln (von hier wird die Mail gesendet)
Set n_dbNames = n_ses.GetDatabase("valnotes", "agress.nsf")
'agress.nsf =Absender Datenbank
If n_dbNames Is Nothing Then Exit Sub
'if 2 und exit
If n_dbNames.IsOpen Then
'if 3
' gefundene Angaben in Server und Dateiname zerlegen
varMailFile = Split(GetMailFile(n_ses.UserName, n_dbNames), "~")
If IsArray(varMailFile) Then
'if 4
If LCase(Right(Trim(varMailFile(1)), 4)) <> ".nsf" Then
varMailFile(1) = Trim(varMailFile(1)) & ".nsf"
' if 5
End If
'end if 5
' Mailfile oeffnen
Set n_dbMail = n_ses.GetDatabase(varMailFile(0), n_ses.UserName)
' Mailfile geoeffnet ?
If n_dbMail Is Nothing Then Exit Sub
'if 6 und exit
If n_dbMail.IsOpen Then
'if 7
' Mailfile erfolgreich geoeffnet => Mail mit Anhang erstellen
Set n_docMail = n_dbMail.CreateDocument
If n_docMail Is Nothing Then Exit Sub
'if 8 und exit
' Maildokument einstellen
With n_docMail
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "hier kommt das Thema rein")
Call .ReplaceItemValue("SendTo", sAdress)
Call .ReplaceItemValue("Principal", sAdress)
End With
' Erstellen des Dateianhanges
If CreateAttachement(n_docMail, sFile) Then
'if 9
' Anhang erfolgreich erstellt
' Mail senden
Call n_docMail.Send(False)
End If 'end if 9
End If 'end if 7
End If 'end if 4
End If 'end if 3
End Sub
Function GetMailFile(ByVal sSearch As String, n_dbN As NotesDatabase) As String
' returns the mail-server and the mail-file of the given user (e-mail address)
' format of the return-string is <mail-server~mail-file>
Dim n_vwUser As NotesView
Dim n_docUser As NotesDocument
GetMailFile = ""
' Ansicht aller Notes-User einstellen
Set n_vwUser = n_dbN.GetView("($Users)")
If n_vwUser Is Nothing Then Exit Function
' Dokument des angegenenen Benutzers ermitteln
' aus deisem wird der Mailserver und Mailfile ermittelt
Set n_docUser = n_vwUser.GetDocumentByKey(LCase(Trim(sSearch)), True)
If n_docUser Is Nothing Then Exit Function
GetMailFile = n_docUser.GetItemValue("MailServer")(0) & "~" & n_docUser.GetItemValue("MailFile")(0)
End Function
Function CreateAttachement(n_docM As NotesDocument, sFileName As String) As Boolean
' Erstellt den Anhang in der zu sendenden Mail
' und schreibt den Mailtext
Dim n_rtBody As NotesRichTextItem
Dim n_eoFile As NotesEmbeddedObject
CreateAttachement = False
' create the Body-Field
Set n_rtBody = n_docM.CreateRichTextItem("Body")
If n_rtBody Is Nothing Then Exit Function
' text of the mail
Call n_rtBody.AddNewLine(1)
Call n_rtBody.AppendText("1. Zeile text")
Call n_rtBody.AddNewLine(1)
Call n_rtBody.AppendText("2. Zeile text")
Call n_rtBody.AddNewLine(3)
' create attachement
Set n_eoFile = n_rtBody.EmbedObject(1454, "", sFileName)
If n_eoFile Is Nothing Then Exit Function
CreateAttachement = True
End Function
ascabg:
--- Zitat ---ist die Schreibweise : StrFile = sh.Range("E" & CStr(intRow)) in excel auf die Spalte E : U:\anhang\name.pdf richtig?
--- Ende Zitat ---
Prinzipiell Ja. Jedoch - ist mir auch erst wieder im Nachhinein eingefallen koennte man auch schreiben
--- Code: ---strFile = sh.Range("E" & CStr(intRow)).Value
--- Ende Code ---
--- Zitat ---Ich glaube es liegt daran, daß kein Attachment erzeugt wird!
--- Ende Zitat ---
Wie muss man das jetzt verstehen?
Wenn Du in der betreffenden Spalte ("E") den Pfad zu der Datei hinterlegt hast und diese Datei auch vorhanden sein, so sollte durch die Zeile
--- Code: ---Set n_eoFile = n_rtBody.EmbedObject(1454, "", sFileName)
--- Ende Code ---
auch ein entsprechender Dateianhang in der Mail erzeugt werden.
Frage:
Liegt die Datei auch in diesem Verzeichnis (ist diese vorhanden)?
Was passiert bei der Ausfuehrung des Codes?
Andreas
Boulbadaoui:
ja die Dateien sind vorhanden und liegen richtig auf dem Verzeichniss, wie im Spalte E beschrieben!
Boulbadaoui:
Hallo,
ist die schreibeweise richtig:
Set n_dbNames = n_ses.GetDatabase("valnotes", "mboulbad.nsf")
'Valnotes=Domino_Server
'mboulbad.nsf=Maildatenbank des Absender
___________________________________
es wird auch nicht zu: Function GetMailFile(ByVal sSearch As String, n_dbN As NotesDatabase) As String springen!
Navigation
[0] Themen-Index
[#] Nächste Seite
[*] Vorherige Sete
Zur normalen Ansicht wechseln