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 '###################################################################################### |