Hallo,
ich habe ein Makro im Excel, mit dem wird die Exceldatei als pdf gespeichert und als Anhang an ein Mail in Lotus Notes angehängt. Das Mail wird nicht sofort versendet, weil der User noch Ergänzungen machen kann.
Einige User verwenden jedoch die Funktion das bei neuen Mails eine automatische Vorgabesignatur eingefügt wird. Somit steht mein Mailtext aus Excel am Ende, was ich nicht will.
Die Signatur zu löschen habe ich bereits geschafft, jetzt möchte ich noch meinen Text aus Exel wieder einfügen, funktiniert nicht.
Habe von Lotus eigentlich keine Ahnung, der Code ist aus dem Internet.
Ich habe die Stelle rot markiert, wo es nicht weiter geht.
Bitte um Hilfe, Danke!
Option Explicit
Public Sub BlattVersenden()
Dim sEmpfaenger As String
Dim sBetreff As String
Dim sInhalt As String
Dim sSaveName As String
sSaveName = Range("Dateiname_pdf").Value '<-- im Tabellenblatt Vorgaben anpassen
sEmpfaenger = Range("email_an").Value '<-- im Tabellenblatt Vorgaben anpassen
sBetreff = Range("Betreff").Value '<-- im Tabellenblatt Vorgaben anpassen
sInhalt = "Hallo liebe Kollegen(innen), " & vbCrLf & vbCrLf & _
"Bitte um Vorbereitung lt. Anhang. " & vbCrLf & _
"Danke." & vbCrLf & vbCrLf & _
"Zusatzinformation: " '<-- Hier Anpassen
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
sSaveName, Quality:= _
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
LotusNotesMail sEmpfaenger, sSaveName, sBetreff, sInhalt
Kill sSaveName
MsgBox "Bitte in Lotus Notes wechseln und kontrollieren ob Mail und Datei ordnungsgemäß erstellt wurden." & vbNewLine & _
"Wenn ja, kann diese Datei geschlossen werden!", vbInformation, "Lotus Notes Mail"
End Sub
Private Sub LotusNotesMail(Empfaenger As String, Dateianhang As String, Betreff As String, Inhalt As String)
Dim Kopie_Empfänger As String, BlindKopie_Empfänger As String
Const EMBED_ATTACHMENT = 1454
Dim server As String, mailfile As String
Dim session As Object
Dim db As Object
Dim doc As Object
Dim rtitem As Object
Dim EmbeddedObject As Object
'Auslesen der Mail-DB
Set session = CreateObject("Notes.NotesSession")
server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)
Set db = session.GETDATABASE(server, mailfile)
Set doc = db.CreateDocument()
doc.Form = "Memo"
doc.SendTo = Empfaenger '<-- Adressaten übergeben
doc.Subject = Betreff
doc.Body = Inhalt
Set rtitem = doc.CREATERICHTEXTITEM("Anhang")
Set EmbeddedObject = rtitem.EMBEDOBJECT(EMBED_ATTACHMENT, "", Dateianhang) '<--Dateianhang mit Pfad und Dateiname überschreiben
doc.FROM = session.UserName
doc.SaveMessageOnSend = True
'Mail erstellen
Dim workspace As Object
Set workspace = CreateObject("Notes.NOTESUIWORKSPACE")
Dim notesUIDoc As Object
Set notesUIDoc = workspace.EDITDOCUMENT(True, doc)
'Body Text löschen wegen Signatur Problem
Call notesUIDoc.GOTOFIELD("Body")
Call notesUIDoc.FieldClear("Body")
Call notesUIDoc.FieldClear("Footer")
'Body Text neu -> funktioniert nicht
Call notesUIDoc.FieldAppendText("Body", doc.Body)
Call notesUIDoc.GOTOFIELD("Body")
'Call doc.Send(False, "") '<-- versendet die Mail sofort ohne anzuzeigen
Set doc = Nothing
Set db = Nothing
Set rtitem = Nothing
Set EmbeddedObject = Nothing
Set session = Nothing
End Sub
LG Herbert
