Okay - next step:
Hier erst einmal der Code für den direkten Versand
eines Sheets. Bei mir liegt er im Modul
mdlSingleMail der Testmappe:
Code: Alles auswählen
Option Explicit
Const EMBED_ATTACHMENT As Long = 1454
Sub SingleMail()
Dim sMailTo As String, sCopyTo As String, sSubject As String, sPDF As String, sBody As String, iMails As Integer
Dim sht As Worksheet
' Schleife durch alle Sheets des WorkBooks, in VBA etwas gefiltert, in LN also ohne Bedeutung
With ActiveSheet
' Füllen der Variablen
sMailTo = .Cells(1, 1)
sCopyTo = .Cells(1, 2)
sSubject = .Cells(1, 3)
sPDF = ThisWorkbook.Path & "\Test " & Date & " " & Timer & ".pdf"
sBody = "Das Protokoll vom " & Date
'erstellt ein PDF des aktiven Sheets im Verzeichnis des Aufrufs
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPDF, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=True, OpenAfterPublish:=True
' Übergabe der Variablen an LN
Send_LN_Mail sMailTo, sCopyTo, sSubject, sPDF, sBody
End With
End Sub
Sub Send_LN_Mail(sMailTo As String, sCopyTo As String, sSubject As String, sPDF As String, sBody As String)
Dim LN_Session As Object, LN_Database As Object, LN_Document As Object
Dim LN_Workspace As Object, LN_EmbedObject As Object, LN_attachement As Object
' Laden der Lotus COM Objekte
Set LN_Session = CreateObject("Notes.NotesSession")
Set LN_Database = LN_Session.GETDATABASE("", "")
'Falls Notes nicht geöffnet ist
If LN_Database.IsOpen = False Then LN_Database.OPENMAIL
' Email erstellen
Set LN_Document = LN_Database.CreateDocument
Set LN_attachement = LN_Document.CreateRichTextItem("sPDF")
Set LN_EmbedObject = LN_attachement.EmbedObject(EMBED_ATTACHMENT, "", sPDF)
With LN_Document
.Form = "Memo"
.sendTo = sMailTo
.copyTo = sCopyTo
.Subject = sSubject
.body = sBody
.Send False
End With
' Jetzt Notes los ...!
Set LN_Workspace = CreateObject("Notes.NotesUILN_Workspace")
Call LN_Workspace.EDITDOCUMENT(True, LN_Document).GOTOFIELD("Body")
' Speicher leeren
Set LN_EmbedObject = Nothing
Set LN_attachement = Nothing
Set LN_Document = Nothing
Set LN_Database = Nothing
Set LN_Session = Nothing
MsgBox "Mail wurde versandt. Bitte zu NOTES wechseln"
End Sub
Die zweite Runde geht an den Versand
mehrerer Sheets mit individuellen Inhalten. Dieser Code gehört ins Modul
mdlMultiMails.
Code: Alles auswählen
Option Explicit
Const EMBED_ATTACHMENT As Long = 1454
Sub MultiMail()
'XL-Variablen:
Dim sMailTo As String, sCopyTo As String, sSubject As String, iMails As Integer
Dim sPDF As String, sBody As String, sht As Worksheet
'LN-Variablen:
Dim LN_Session As Object, LN_Database As Object, LN_Document As Object
Dim LN_Workspace As Object, LN_EmbedObject As Object, LN_attachement As Object
'>>>>> XL-relevant: <<<<<
'Schleife durch alle Sheets des WorkBooks per VBA gefiltert
Application.ScreenUpdating = False
For Each sht In ThisWorkbook.Sheets
'Filter
If Left(sht.CodeName, 4) <> "tab_" Then
sht.Activate
With ActiveSheet
'Füllen der Variablen
sMailTo = .Cells(1, 1)
sCopyTo = .Cells(1, 2)
sSubject = .Cells(1, 3)
sPDF = ThisWorkbook.Path & "\Test " & Date & " @ " & Timer & ".pdf"
sBody = "Das Protokoll vom " & Date
iMails = iMails + 1
'erstellt ein PDF des aktiven Sheets im Verzeichnis des Aufrufs
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPDF, _
Quality:=xlQualityMinimum, IncludeDocProperties:=False, _
IgnorePrintAreas:=True, OpenAfterPublish:=False
End With
''>>>>> LN-relevant: <<<<<
'Laden der Lotus COM Objekte
Set LN_Session = CreateObject("Notes.NotesSession")
Set LN_Database = LN_Session.GETDATABASE("", "")
'Falls Notes nicht geöffnet ist
If LN_Database.IsOpen = False Then LN_Database.OPENMAIL
'Email erstellen
Set LN_Document = LN_Database.CreateDocument
Set LN_attachement = LN_Document.CreateRichTextItem("sPDF")
Set LN_EmbedObject = LN_attachement.EmbedObject(EMBED_ATTACHMENT, "", sPDF)
With LN_Document
.Form = "Memo"
.sendTo = sMailTo
.copyTo = sCopyTo
.Subject = sSubject
.body = sBody
.Save True, False
End With
'Jetzt Notes es los ...!
Set LN_Workspace = CreateObject("Notes.NotesUILN_Workspace")
Call LN_Workspace.EDITDOCUMENT(True, LN_Document).GOTOFIELD("Body")
'LN_Document.Save(true, false)
'Speicher für aktuelle Mail leeren
Set LN_Document = Nothing
Set LN_attachement = Nothing
''>>>>> XL-relevant: <<<<<
'Filter-Ende
End If
'Schleifen-Return
Next
Application.ScreenUpdating = True
'Speicher für LN leeren
Set LN_EmbedObject = Nothing
Set LN_Database = Nothing
Set LN_Session = Nothing
MsgBox iMails & " Mails für den Versand vorbereitet, bitte zu NOTES > ENTWÜRFE wechseln."
End Sub
Was in den Subs jeweils passiert, ist in den Kommentaren beschrieben. Den Aufruf für beide Versionen findest Du im Makromenü Alt + F8.
Mangels Testumgebung kann ich Fehlermeldungen natürlich überhaupt nicht ausschließen. Hier bist Du gefragt: Fehlermeldungen am liebsten als
Screenshot, in dem auch die Fehlerzeilen sichtbar sind.
Viel Erfolg! & lg
, falls nicht, frage bitte Admins, Kollegen usw.
