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
