Hallo zusammen, nachdem mir schon einige geholfen haben mein Projekt umzusetzen, hoffe ich nochmal auf Hilfe bei meinem letzten Problem.
Es funktioniert soweit alles, es wird aus Excel heraus die Mail versendet und es erfolgt ein Eintrag unter "gesendet". Doch wenn ich mir unter gesendet die Mail aufrufe, so fehlt der komplette Inhalt. Ich erhalte auch keine Fehlermeldung oder sonstiges. Anbei mein aktueller Code:
Sub EinzelMail()
Dim session As Object
Dim db As Object
Dim doc As Object
Dim strTo As Variant
Dim strPath As String
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim AttachME As Object 'The attachment richtextfile object
Dim Workspace As Object
Dim uidoc As Object
Dim Empfaenger As String
Dim EmpfNachName As String
Dim EmpfMail As String
Dim Termin As Date
Dim Betreff As String
Dim Anrede As String
Anrede = Sheets("Formular").Range("E3").Value
Empfaenger = Sheets("Formular").Range("C10").Value
EmpfNachName = Trim(Mid(Empfaenger, (InStr(1, Trim(Empfaenger), " ") + 1), 50))
EmpfMail = Sheets("Formular").Range("C3").Value
Termin = Sheets("Formular").Range("D3").Value
Betreff = Sheets("Formular").Range("K3").Value
Set session = CreateObject("Notes.NotesSession")
Set db = session.GetDatabase(SERVER, MAILIN.nsf") 'Server und Pfad der MailInDB, zu finden in NotesKachel-Eigenschaften
If db.IsOpen = False Then db.OPENMAIL
Set doc = db.CreateDocument
With doc
.form = "Memo"
.SendTo = EmpfMail
.Subject = Betreff
.Sign = "0"
.SaveMessageOnSend = True
.Save = True
.posteddate = Now()
.ReplyDate = Termin
End With
Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Set uidoc = Workspace.EDITDOCUMENT(True, doc)
With uidoc
.GOTOFIELD ("Body")
If Anrede = "Herr" Then
.inserttext ("Sehr geehrter Herr " & EmpfNachName & "," & vbCrLf & vbCrLf)
Else
.inserttext ("Sehr geehrte Frau " & EmpfNachName & "," & vbCrLf & vbCrLf)
End If
.inserttext ("nachstehend erhalten Sie Ihre Planungsaufgabe:" & vbCrLf)
.inserttext (vbCrLf)
Sheets("Formular").Range("A5:G22").Copy 'Bereich mit dem zu übernehmenden Text
.Paste
.inserttext (vbCrLf)
Call doc.Save(True, False, True)
.send
.document.SaveOptions = "0"
.Close
End With
Set EmbedObj = Nothing
Set AttachME = Nothing
Set uidoc = Nothing
Set Workspace = Nothing
Set db = Nothing
Set doc = Nothing
Set session = Nothing
MsgBox "Die Mail wurde erfolgreich erstellt. Wechseln Sie nun zu Lotus Notes!", vbInformation
End Sub
Irgendwie hab ich Tomaten auf den Augen, zumindest find ich den Fehler nicht.
Ich hoffe daher nochmals auf Eure Hilfe und sag im voraus vielen herzlichen Dank.