Moin allerseits,
vielleicht vorab zum Szenario meiner Anfrage: Ich betreibe das Forum VBAsteleien.de, das sich mit VBA in der MS-Office-Familie mit Schwerpunkt Excel beschäftigt. Dort wurde vor einiger Zeit ein Thema (siehe Titel) aufgemacht, dessen XL-VBA-Seite in mehreren Versionen gelöst werden konnte. Versendet sollen sowohl einzelne als auch Serien-Mails mit Daten von Empfänger, CC, Betreff bis hin zu Body und vor allem einem Anhang aus XL per
IBM Notes 10.
Leider gibt es auf VBAsteleien.de niemand (außer dem Fragesteller), der LN zur Verfügung hat. Der folgende Code hat wenigstens schon mal erfolgreich zum Einzelversand geführt. Wenn damit allerdings Verteiler mit > 50 Empfängern erreicht werden sollen, wird die Sache träge: von mehr als drei Minuten wird berichtet. Wir suchen also nach einer Lösung, die Serien-Mails deutlich beschleunigt und haben über diese Konzepte nachgedacht:
- Tatsächlich sequenziell Einzelmails, die dann zuerst im LN Postausgang abgelegt werden und anschließend versandt werden. Dafür haben wir aber keinen LN-Code gefunden
- Alternativ der direkte Versand jeder einzelnen Mail und Rückkehr zu VBA für die nächste (m.E. die schlechteste Methode). Hier zu nutzen wir bisher den Code unten, wobei ich vermute, dass sich der durch das gezielte, nicht für jede Mail wiederholte Laden/Entladen der LN-COM-Objekte beschleunigen ließe.
Der Code liegt in einem allg.VBA-Modul:
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
iMails = 1
'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, iMails
End With
End Sub
Sub Send_LN_Mail(sMailTo As String, sCopyTo As String, sSubject As String, sPDF As String, sBody As String, iMails As Integer)
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
.SaveMessageOnSend = True
.PostedDate = Now()
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 iMails & " Mail(s) wurde(n) erstellt. Bitte zu NOTES wechseln"
End Sub
Als Idee würde ich für einen Mehrfachversand per Schleife einen Teil der Set LN_... = Nothing an den Schluss der Schleife stellen. Das könnte dann vielleicht so aussehen:
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
.SaveMessageOnSend = True
.PostedDate = Now()
End With
'Jetzt Notes es los ...!
Set LN_Workspace = CreateObject("Notes.NotesUILN_Workspace")
Call LN_Workspace.EDITDOCUMENT(True, LN_Document).GOTOFIELD("Body")
'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 wechseln."
End Sub
Ganz schön viel auf einmal und für einen ersten Beitrag, ich weiß. Vielleicht kann ja trotzdem jemand (wahrscheinlich mit nur wenigen Zeilen
) helfen.
Dafür schon vorab ganz lieben Dank! die wir natürlich auch mit einem entsprechenden Link hierher belohnen
Neueste Beiträge
