Mail mit Anhang aus Lotus Notes
05.07.2018 10:53:54
Berit
ich habe einen Code, der wie gewünscht eine Mail mit Anhang als Entwurf speichert (Senden-Zeile ist kommentiert). Der Dateipfad für besagten Anhang steht im Code. Genau das möchte ich aber ändern: Statt den Pfad im Code einzugeben, soll Excel den Pfad aus einer in einem anderen Modul definierten Variablen ("Dateipfad") nehmen. Die Übernahme anderer Variablen aus diesem Modul (z. B. die Mail Empfänger MailV und MailCC) funktioniert. Sogar wenn ich mich direkt auf die Zelle beziehe "Anhang=Range("D109")", klappt es nicht.
Hier der Code:
Option Explicit
Option Private Module
Public MailV As Variant
Public MailCC As Variant
Public LfdNr As String
Public Thema As String
Public ADatum As String
Public EDatum As String
Public Themalink As String
Public Dateipfad As String
Dim Anhang As String
Dim NotesSession As Object
Dim NotesMailFile As Object
Dim NotesDocument As Object
Dim NotesField As Object
Dim Signature As String
Dim db As Object
Dim Attach As Object
Dim EmbedObject As Object
Public Sub Mailversand()
' Verbindung zu Lotus Notes herstellen
Set NotesSession = CreateObject("Notes.NotesSession")
Set NotesMailFile = NotesSession.GETDATABASE("", "")
NotesMailFile.OPENMAIL
'Werte setzen
Set NotesDocument = NotesMailFile.CreateDocument
Set NotesField = NotesDocument.APPENDITEMVALUE("Subject", LfdNr & " " & Thema) ' Anhang = "D:\Users\BeritJoannaRohde\Documents\gummibärchen.xlsx"
Signature = NotesMailFile.GetProfileDocument("CalendarProfile") _
.GetItemValue("Signature")(0) 'holt die eigene _
Signatur aus Lotus
'Anfang Text
With NotesField
.APPENDTEXT "Sehr geehrte Damen und Herren," & vbNewLine & vbNewLine _
.ADDNEWLINE 2 '2 Leerzeilen einfügen
.APPENDTEXT Signature
End With
'Anhang
Set EmbedObject = Attach.EmbedObject(1454, "", Anhang)
'Empfangsbestätigung anschalten:
Call NotesDocument.ReplaceItemValue("ReturnReceipt", "1")
'Senden der Mail
'Call NotesDocument.Send(False)'kommentieren wenn Mail nicht direkt abgesendet sondern als _
_
_
Entwurf gespeichert werden soll
On Error Resume Next
' Mail speichern
Call NotesDocument.Save(True, True)
Call NotesDocument.Open(True, True)
'Meldung wenn fertig
' MsgBox "Die E-mail ist versendet!.", vbInformation, "E-mail versenden..."
'Aufräumen
Set NotesSession = Nothing
Set NotesMailFile = Nothing
Set NotesDocument = Nothing
Set NotesField = Nothing
Set EmbedObject = Nothing
Set Attach = Nothing
Exit Sub
err:
MsgBox "Die e-mail ist nicht erstellt!.", vbInformation, "E-mail versenden..."
Exit Sub
End Sub
Anzeige