Readdy Write  
0,00 €
Your View Money
Views: Count
Self 20% 0
Your Content 60% 0

Users by Links 0
u1*(Content+Views) 10% 0
Follow-Follower 0
s2*(Income) 5% 0

Count
Followers 0
Login Register as User

Excel Lotus Mail: Email mit Lotus Mail versenden mit vba

04.02.2019 (👁399)


 

 

Kleines Code-Snippet zum Erstellen von Emails aus Excel über Lotus Notes

Mit diesem kleinen vba Code kann man Emails unter Lotus Notes erstellen.

'######################################################################################

'        Application.Dialogs(xlDialogSendMail).Show _

'        Empfaenger, Betreff

On Error Resume Next

'#  MAIL VORBEREITEN   ################################################################

    'MsgBox ("Bitte achten Sie darauf, dass in Notes keine popups geöffnet sind wie z.B.: ' _

    Sie haben eine neue Mail erhalten'")

    'MsgBox ("Bei einer Fehlermeldung bitte auf 'Beenden' klicken." & VBA.Chr(13) & "Die _

    Mail wird trotzdem vorbereitet." & VBA.Chr(13) & VBA.Chr(13) & "Danke")

    'Variablen Dimensionieren, die benötigt werden, um das Mail zu senden

    Dim mRows As Integer

    Dim mCols As Long

    Dim Maildb As Object 'Die Datenbank

    Dim UserName As String 'Der Benutzername

    Dim MailDbName As String 'Der Datenbankname

    Dim MailDoc As Object 'Das Maildokument selbst

    Dim AttachME As Object 'Der Anhang (Richtext)

    Dim Session As Object 'Die Notes Session

    Dim EmbedObj As Object 'Ein eingebettetes Objekt (Anhang)

    Dim ClipBoard As DataObject

    Dim SaveIt As Boolean

   

    Dim Subject As String

    Dim Attachment1 As String

    Dim Attachment2 As String

    Dim Recipient As String

    Dim cc As String

    Dim BodyText As String

   

    Subject = "Erläuterungen "

    Recipient = Empfaenger

    cc = "Abteilung"

   

    Attachment = ThisWorkbook.Path & "\" & Dateiname

    'Attachment2 = "C:\Pfad\Datei2.pdf"

   

    BodyText = ThisWorkbook.Sheets("ExcelBlatt").Cells(229, 4).Value 'Chr(13) & Chr(13) & Chr(13) & "Hallo," & Chr(13) & "Im Anhang findest du die aktuelle Vorlage Zahlen." & Chr(13) & ""

   

    Dim filename As String

    Dim numrows As Long

    Dim numcols As Integer

    Dim r As Long

    Dim c As Integer

    Dim data

    Dim exprng As Range

    Set exprng = Selection

    numcols = exprng.Columns.Count

    numrows = exprng.Rows.Count

        'Die Session starten

    Set Session = CreateObject("Notes.NotesSession")

   

        'Den Benutzernamen auslesen und den Dateinamen

        'der MailDB errechnen

        'Dies wird nicht überall benötigt. Auf manchen

        'Systemen kann auch ein leerer String übergeben werden

    UserName = Session.UserName

        'MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) _

        - InStr(1, UserName, " "))) & ".nsf"

    MailDbName = "mail\saog.nsf"

  

    'Datenbank öffnen

    Set Maildb = Session.GETDATABASE("", MailDbName)

     If Maildb.IsOpen = True Then

          'Fertig zum mailen!

     Else

         Maildb.OPENMAIL

     End If

    

    'Ein neues Maildokument erstellen

    Set MailDoc = Maildb.CREATEDOCUMENT

    MailDoc.Form = "Memo"

    MailDoc.sendto = Recipient & ", " & cc

   

    MailDoc.Subject = Subject

    MailDoc.body = BodyText

    MailDoc.SAVEMESSAGEONSEND = SaveIt

  

   

    'Eingebettete Objekte und Anhänge hinzufügen

    If Attachment <> "" Then

        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")

        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, _

        "Attachment")

        'MailDoc.CREATERICHTEXTITEM ("Attachment")

    End If

   

    If Attachment2 <> "" Then

        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")

        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment2, _

        "Attachment")

        'MailDoc.CREATERICHTEXTITEM ("Attachment")

    End If

 

    Dim Workspace As Object

    Set Workspace = CreateObject("Notes.NOTESUIWORKSPACE")

    Call Workspace.editdocument(True, MailDoc).GOTOFIELD("Body")

 

  '  MsgBox ("Die Mail wurde erstellt")

    'Aufräumen

    Set Maildb = Nothing

    Set MailDoc = Nothing

    Set AttachME = Noth

    Set Session = Nothing

    Set EmbedObj = Nothing

'######################################################################################