email mit Lotus Notes nur anzeigen,nicht senden?

Sub NotesMail() Dim strEmpfaenger, strBetreff, strText, strcc, strbcc As String Dim strFile As String Dim Merker Dim MerkerRef Dim Merkertext Dim Antwort Dim Fehler On Error GoTo Fehler Antwort = Shell("C:\Program Files\Lotus\Notes\notes.exe " & _ "=H:\Notes\data\notes.ini", vbMinimizedFocus) AppActivate "Microsoft Excel" strEmpfaenger = "Deine email-Adresse" strBetreff = "Test" strText = "testmail" 'strFile = "" NotesMailSend strEmpfaenger, strBetreff, strText, strcc, _ strbcc, strFile Exit Sub Fehler: NotesMail Exit Sub End Sub

Function NotesMailSend(strEmpfaenger As Variant, strBetreff As Variant, _ strText As Variant, strcc As Variant, strbcc As Variant, strFilename As _ String) ' Dimensionierung der Objektvariablen Dim objNotes As Object, objNotesDB As Object, objNotesMailDoc As Object Dim SendItem, NCopyItem, BlindCopyToItem, i As Integer, rtitem Dim msg As String ' Zuweisung der Objektvariablen 'On Error GoTo ExitF Set objNotes = GetObject("", "Notes.Notessession") Set objNotesDB = objNotes.GetDatabase("", "") ' Öffnen der Standard-Maildatenbank / Erstellen neues Maildokument Call objNotesDB.OPENMAIL 'AppActivate "Microsoft Excel" Set objNotesMailDoc = objNotesDB.CreateDocument objNotesMailDoc.Form = "Memo" Call objNotesMailDoc.Save(True, False) Set SendItem = objNotesMailDoc.APPENDITEMVALUE("SendTo", "") Set NCopyItem = objNotesMailDoc.APPENDITEMVALUE("CopyTo", "") Set BlindCopyToItem = objNotesMailDoc.APPENDITEMVALUE("BlindCopyTo", "") objNotesMailDoc.sendto = Split(strEmpfaenger, ";") objNotesMailDoc.Subject = strBetreff Set rtitem = objNotesMailDoc.CreateRichTextItem("Body") objNotesMailDoc.body = strText rtitem.ADDNEWLINE (1) 'Anhang 'Call rtitem.EmbedObject(1454, "", strFilename) ' als Entwurf speichern Call objNotesMailDoc.Save(True, False) 'Senden Call objNotesMailDoc.Send(False) objNotesMailDoc.RemoveItem ("DeliveredDate") Call objNotesMailDoc.Save(True, False) ' Nachricht an Benutzer msg = "Die E-Mail wurde erfolgreich versendet!" MsgBox msg, vbInformation, "email" ' Objektvariablen zurücksetzen Call objNotes.Close Set objNotes = Nothing ExitF: End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hi,
ich hab in meiner Makrosammlung eins gefunden, dass eine LotusNotes Mail erstellt aber nicht absendet.
Vielleicht hilft dir das ja? Mich bitte nicht fragen, ich verstehs nicht (hab nur c&p gemacht).

Sub SendAsMail()
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 = "Zahlen von " & Date
Recipient = "Hans@Wurst.de"
cc = ""
Attachment = "C:\Pfad\Datei1.pdf"
Attachment2 = "C:\Pfad\Datei2.pdf"
BodyText = Chr(13) & Chr(13) & Chr(13) & "Moin Hans," & Chr(13) & "Im Anhang findest du  _
die aktuellen 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
End Sub

Beliebteste Forumthreads (12 Monate)

email mit Lotus Notes nur anzeigen,nicht senden?

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

email mit Lotus Notes nur anzeigen,nicht senden?

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread