Seriendruck Pläne per Mail verschicken

[d'r Bastler]

Single also:

Dann setzte bitte direkt vor diese Zeile entweder den Code
On Error Resume Next oder als erstes Zeichen der Zeile ein Hochkomma (Zeichen über der # ganz rechts auf der Tastatur.)

Der Test des mdlMultiMails dauert, so Du denn bitte die Testumgebung vorbereitet hast (Zeitaufwand drei Minuten) , genau einen Klick und einmal LN öffnen ...

Mein Coden und die Recherche zu LN stehen im Moment zu Deinen Tests in einem Aufwandsverhältnis von 100: 1 Komm für die 1 in die Puschen, bitte.
lg

[Hobbit]

Vielen Dank.
Ich kann es leider Montag erst Testen, weil ich es nur in der Firma Testen kann.
Ich werde Montag ab 8 Uhr sofort daran gehen.
Ich glaube dir zu 100% das du da sehr viel Zeit investiert und das finde ich Überwältigend.

Ich finde es Faszinierend wie du dich da rein hängst.

Vielen lieben Dank für die Tolle Unterstützung.

[Hobbit]

Moin,

ich habe es endlich geschafft die beiden Beispiele zu Testen und zu überarbeiten.
Vorher habe ich es leider nicht hinbekommen, da ich zur Zeit hier im Büro alleine bin.

1. mdlSingleMail

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, 16)
        sCopyTo = .Cells(2, 16)
        sSubject = .Cells(1, 17)
        sPDF = ThisWorkbook.Path & "\Einsatzplan.pdf"
        sBody = .Cells(3, 16)
        
        'erstellt ein PDF des aktiven Sheets im Verzeichnis des Aufrufs
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPDF, _
        Quality:=xlQualityStandard, IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
        
        ' Ü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."

End Sub

1. Bei dem Standard Text habe ich auf eine Zelle verwiesen, damit ich dann individuell einen Text Pflegen kann, ohne das ich VBA öffnen muss.
2. Dann habe ich den Druckbereich auf False geändert, damit mir nur der Druckbereich ausgegeben wird.
3. Habe ich OpenAfterPublish auf False geänedert, weil ich nicht jede PDF sehen muss.



2. 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 sht.Name <> "Aushang" Then
            sht.Activate
            With ActiveSheet
            
                'Füllen der Variablen
                sMailTo = .Cells(1, 16)
                sCopyTo = .Cells(2, 16)
                sSubject = .Cells(1, 17)
                sPDF = ThisWorkbook.Path & "\Einsatzplan.pdf"
                sBody = .Cells(3, 16)
                iMails = iMails + 1
                
                'erstellt ein PDF des aktiven Sheets im Verzeichnis des Aufrufs
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPDF, _
                Quality:=xlQualityMinimum, IncludeDocProperties:=False, _
                IgnorePrintAreas:=False, 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
                .Send 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 wurden Versand "

End Sub

1. Bei dem Standard Text habe ich auf eine Zelle verwiesen, damit ich dann individuell einen Text für jeden einzelnen Fahrer Pflegen kann, ohne das ich VBA öffnen muss.
2. wird die Email direkt gesendet und nicht erst in Entwürfe gespeichert.


Beide Codes Funktionieren jetzt wunderbar.
Ich bin voll faszinierend was du da auf die Beine gestellt hast.


Tut mir leid wenn es nicht Zeitnah geklappt hat mit den Test´s, aber ich bin diese Woche leider alleine.
Du bist echt in VBA Top, das würde ich nie so hinbekommen.

Vielen lieben dank für deine Tolle Unterstützung.

[d'r Bastler]

Jaa!! Der Wahnsinn!!

Moin Jens!

Herzlichen Dank für Deinen differenziert-qualifizierten Testbericht!

Denn jetzt kann ich daraus VBAsteln, was neben der Unterstützung für Dich mein zweites Ziel war: Nämlich so etwas wie eine Lösung für alle Interessenten, die auch noch mit IT-Antiquitäten arbeiten (müssen), anzubieten. Dass da Interesse besteht, sieht man an den über 11.000 Aufrufen (Rekord-verdächtig!) des Themas.

Ich bin mir sicher, dass es da noch LN-Spezialisten gibt, die unser Machwerk ein wenig feintunen könnten. Mal schau'n was draus wird. Sicher ein neues Thema, diesmal als Lösung!

Genieße die Ruhe im Büro

lg

[d'r Bastler]

Moin Jens,

zwei Fragen hätte ich dann doch noch:

Du hast für Multimail bei 50 Empfängern von einer Verarbeitungszeit von drei Minuten berichtet. Ist das in der letzten Version besser?

Habe ich das richtig verstanden: Auch die Multimails werden direkt versandt und landen nicht erst im Entwürfe-Ordner von LN?

Danke Dir recht heftig!
lg

[Hobbit]

Moin,
1. der Mailversand für 16 Mails, weil noch nicht alle ihre Mail Adresse rausgerückt haben, dauert 1 min 50 sec.
Was aber auch nicht so schlimm ist, weil sie ja direkt Versendet werden und ich sie ja jetzt nicht mehr einzeln noch Verschicken muss.

2. Bei der Multimail ist es jetzt auch so das sie direkt Versendet werden.
Ich habe den Punkt:

Code: Alles auswählen

 .Save True, False

auf

Code: Alles auswählen

.Send False

geändert.

Ich kann mich nur nochmal für die Hammer Unterstützung bedanken.

[d'r Bastler]

Moin,

na - Deine Änderung erklärt dann, warum sie nicht erst gespeichert werden, was ich gehofft hatte, dass es zur Beschleunigung beiträgt. Beinahe 6 Sekunden pro Mail ist einfach ein bisschen lang.

Aber vielleicht lässt sich daran ja noch was drehen ...

lg

[Hobbit]

Kann es sein, weil es ja erst Umgewandelt wird als PDF?

Wenn sie aber erst in Entwürfe gespeichert werden muss ich ja alle einzeln Versenden.
So werden sie ja direkt versendet, was ich besser finde.

Es kann natürlich auch an unseren Hammer System liegen das es so lange dauert.

[d'r Bastler]

Moin Jens,
eigentlich sollten durch die sht-Schleife Dien multimails in die Entwürfe gehen und dann als letzter Schritt erst die Übermittlung aus Notes. Selbst wenn Ihr noch mit 486ern arbeitet, denke ich, dass das Problem eher im Laden/Entladen (Set LNxxx / Set LNxxx to Nothing) der LN-COM-Obkekte liegt.

Ich werde mal noch weiter forschen ...

[Hobbit]

Moin,

ich hätte da noch eine bitte!!!

Wenn ich auf dem Button zum Versenden drücke, soll erst eine abfrage erscheinen "Soll der Einsatzplan verschickt werden? ".

Ich habe da was gefunden, aber wenn ich auf nein klicke, wird es trotzdem versendet.

Code: Alles auswählen

Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Soll der Einsatzplan Verschickt werden?"    ' Define message.
Style = vbYesNo Or vbCritical Or vbDefaultButton2    ' Define buttons.
Title = "MsgBox Demonstration"    ' Define title.
Help = "DEMO.HLP"    ' Define Help file.
Ctxt = 1000    ' Define topic context.
        ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' User chose Yes.
    MyString = "Yes"    ' Perform some action.
Else    ' User chose No.
    MyString = "No"    ' Perform some action.
End If

Kann mir da noch mal einer helfen bitte?

Vielen dank.