AW: Tabellenblatt als PDF per Lotus Notes
11.05.2022 09:34:50
Herbert_Grom
Hallo Alexander,
den folgenden Code habe ich für dieses Problem gesichert. Ich kann es aber nicht ausprobieren, da ich kein Lotus Notes habe. Vielleicht kommst du ja damit zurecht:
'* Mail-Versand über Lotus Notes
Sub Email_LotusNotes(txtmail As String)
Dim strEmpfaenger, strBetreff, strText, strCC, strbcc$, strFile$
Set wsmail = ThisWorkbook.Sheets("E-Mail erzeugen")
Set wsbas = ThisWorkbook.Sheets("Basisdaten")
strEmpfaenger = wsmail.Range("D7").Value 'E-Mail Adressse An:
strBetreff = wsmail.Range("C11").Value 'Betreff
strText = txtmail 'Body
strFile = "C:\tmp\test.txt" 'ActiveDocument.FullName
NotesMailSend strEmpfaenger, strBetreff, strText, strCC, strbcc, strFile
End Sub
Function NotesMailSend(strEmpfaenger As Variant, strBetreff As Variant, _
strText As Variant, strCC As Variant, strbcc As Variant, strFileName As String)
Dim objNotes As Object, objNotesDB As Object, objNotesMailDoc As Object
Dim SendItem, NCopyItem, BlindCopyToItem, i As Integer, rtitem, Msg$
On Error GoTo ExitF
Set objNotes = GetObject("", "Notes.Notessession")
Set objNotesDB = objNotes.getdatabase("", "")
'* Öffnen der Standard-Maildatenbank / Erstellen neues Maildokument
Call objNotesDB.OPENMAIL
Set objNotesMailDoc = objNotesDB.createdocument
objNotesMailDoc.Form = "Memo"
Call objNotesMailDoc.Save(True, False)
Set SendItem = objNotesMailDoc.APPENDITEMVALUE("SendTo", "")
Set NCopyItem = objNotesMailDoc.APPENDITEMVALUE("CopyTo", "")
Set BlindCopyToItem = objNotesMailDoc.APPENDITEMVALUE("BlindCopyTo", "")
objNotesMailDoc.SendTo = strEmpfaenger
objNotesMailDoc.Subject = strBetreff
Set rtitem = objNotesMailDoc.CREATERICHTEXTITEM("Body")
objNotesMailDoc.body = strText
rtitem.ADDNEWLINE (1)
Call rtitem.EMBEDOBJECT(1454, "", strFileName)
'* Mail senden
Call objNotesMailDoc.Save(True, False)
Call objNotesMailDoc.Send(False)
objNotesMailDoc.RemoveItem ("DeliveredDate")
Call objNotesMailDoc.Save(True, False)
'* Nachricht an Benutzer
Msg = "Die E-Mail wurde erfolgreich versendet!"
MsgBox Msg, vbInformation, "Notesmail versenden..."
'* Objektvariablen zurücksetzen
Call objNotes.Close
'* Leider funktioniert der Quit-Befehl aus irgend einem Grund nicht.
'''objNotes.Quit
Set objNotes = Nothing
ExitF:
MsgBox "Bitte prüfen Sie, ob Lotus Notes als E-Mail Client zur Verfügung steht und ordnungsgemäß funktioniert.", vbCritical, "Hinweis"
End Function
Servus
