Hallo Forum,
ich verschicke aus Access 2010 per VBA Mails über IBM Notes 9. Vor dem Versand, sollen mir die formatierten Mails (unproportionale Schrift) in Notes angezeigt werden, ggf. manuell ergänzt und dann per "Senden" das Mail verschicken.
Mein bisheriger Stand:
a) unformatiertes Mail anzeigen lassen => geht
b) formatiertes Mail versenden => geht
Wenn ich beides kombiniere, ist der Mailinhalt (body) leer. Die betreffende Stelle ist weit unten bei
' Senden / Gesendet anzeigen oder als Entwurf speichern
If bolSenden = True Then
=> senden formatierte Mail klappt
else
=> anzeigen formatierte Mail klappt nicht
Könnt Ihr mir bitte helfen?
Dank und Gruß
Ingo
Function NotesMail_senden(strSendTo As String, _
strCopyTo As String, _
strBlindCopyTo As String, _
strSubject As String, _
strMessage As String, _
strAttachment As String, _
Optional bolSenden As Boolean = True)
On Error GoTo NotesMail_Err
Dim Workspace As Object
Dim NotesSession As Object
Dim NotesDatabase As Object
Dim NotesDocument As Object
Dim NotesRTStyle As Object
Dim NotesRTItem As Object
Dim NotesATTACHMENT As Object
Dim sMessage As String
' Session starten
Set NotesSession = CreateObject("Notes.Notessession")
' Create a new Style
Set NotesRTStyle = NotesSession.CreateRichTextStyle
' Verbindung zur Datenbank
Set NotesDatabase = NotesSession.GetDatabase("", "")
NotesDatabase.OpenMail
' Neues Dokument
Set NotesDocument = NotesDatabase.CreateDocument
' Neues NotesRichTextItem erstellen, Body im RichText formatieren
Set NotesRTItem = NotesDocument.CreateRichTextItem("Body")
' Anhang
If strAttachment <> "" Then Set NotesATTACHMENT = NotesRTItem.EMBEDOBJECT(1454, "", strAttachment, "Sample")
' Nachricht
sMessage = strMessage
' Nachricht formatieren
NotesRTStyle.NotesFont = 4 ' Courier
'NotesRTStyle.Bold = True ' Fett
NotesRTStyle.NotesColor = 2 ' Rot
NotesRTStyle.FontSize = 10 ' 10
Call NotesRTItem.AppendStyle(NotesRTStyle)
Call NotesRTItem.AppendText(sMessage)
' Formatierungen / Texte
With NotesDocument
.Form = "Memo"
.ReplaceItemValue "SendTo", strSendTo
.ReplaceItemValue "CopyTo", strCopyTo
.ReplaceItemValue "BlindCopyTo", strBlindCopyTo
.ReplaceItemValue "Subject", strSubject
' Senden / Gesendet anzeigen oder als Entwurf speichern
If bolSenden = True Then
.SAVEMESSAGEONSEND = True
.PostedDate = Now(): 'Im Postausgang wird die Mail sichtbar
.Send True
Else
Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Call Workspace.EditDocument(True, NotesDocument).GotoField("Body") 'Positioning Cursor z.B. Subject o. Body
'Call .Save(True, False)
End If
End With
Set NotesRTItem = Nothing
Set NotesRTStyle = Nothing
Set NotesDocument = Nothing
Set NotesDatabase = Nothing
Set NotesSession = Nothing
'If bolSenden = True Then MsgBox "Mail wurde gesendet!", vbInformation Else MsgBox "Mail wurde gespeichert!", vbInformation
Exit Function
NotesMail_Err:
MsgBox Err.Description, vbExclamation, "Fehler! (" & Trim$(Str$(Err)) & ")"
End Function